StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
primarykey
Id
20787491
data
AcceptedAnswerId
0
AnswerCount
0
ClosedDate
CommentCount
0
CommunityOwnedDate
CreationDate
2013-12-26T15:52:19.040
FavoriteCount
0
LastActivityDate
2013-12-26T15:52:19.040
LastEditDate
LastEditorUserId
0
OwnerUserId
973283
ParentId
20748873
PostTypeId
2
Score
0
ViewCount
0
LastEditorDisplayName
text
Body
Please never post code as an image since someone who wants to try it out must type it. You can edit your question and add a new section including revised code if necessary. My copy of your code (plus line numbers) is: <pre><code> 1 Public Sub SelectFirstBlankCell() 2 Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer 3 Dim currentRowValue As String 4 sourceCol = 1 'column F has a value of 6 5 rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row 6 'for every row, find the first blank cell and select it 7 For currentRow = 1 To rowCount 8 currentRowValue = Cells(currentRow, sourceCol).Value 9 If IsEmpty(currentRowValue) Or currentRowValue = "" Then 10 Cells(currentRow, sourceCol).Select 11 End If 12 Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1, 1)).Merge 13 ActiveCell.Select 14 If IsEmpty(currentRowValue) Or currentRowValue = "" Then 15 Cells(Range("sourceCol:21")).Delete 16 End If 17 Next 18 End Sub </code></pre> I am sure we all started selecting cells and accessing the ActiveCell because the macro recorder does this. However, selecting cells is slow and it is very easy to lose track of what is selected. I believe this is your main problem. Problem 1 The end value for a For-Loop is fixed at the start; Any attempt to reduce <code>rowCount</code> when you delete something will have no effect on the For-Loop. Problem 2 I suspect you mean the range in line 15 to be <code>sourceCol & ":" & currentRow</code>. Problem 3 In line 10 you select a cell if it is blank. In line 12 you merge the active cell whether or not you have just selected it. This means your code attempts a merge for every row. Problem 4 Column 1 is the column that might be blank. Suppose row 1000 is the last row with a supplier's name but row 1005 is the last row with a product. Your code would not process rows 1001 to 1005. Problem 5 Function IsEmpty() only returns sensible values for Variants. A Variant is either a cell or a variable that can hold different types of value. I have not tried your code so there may be more mistakes. Do get dispirited. To the best of my knowledge, problem 1 is not documented. I had to discover this "feature" for myself by attempting code similar to yours. The specification for Function IsEmpty() states its limitations but, unless you fully understand Variants, the significance is not obvious. The other problems are easy errors to make and only practice will reduce their frequency. Below is my solution to your problem. It is not how I would code it for myself but I think I have introduced enough new concepts for one solution. I do not say much about the syntax of the VBA statements I use since it is usually easy to look up a statement once you know it exists. Ask if necessary but please try to understand the code before asking. I do not like deleting in situ; it is slow and, if your code is faulty, you have to load the previous version of the worksheet and start again. I have a source (<code>Src</code>) and a Destination (<code>Dest</code>) worksheet. I use constants for values that might change but not during a single run of your macro. You assume the address and other details for Jan's Supply on rows 2 and 3 match. I am paranoid and never make assumptions like this. If my code would discard important information if rows 2 and 3 did not match, I check they match. I also allow for rows like this because I have encountered them: <pre><code>John's supply Cookies 555 Main Street CA Cakes Littleville CA </code></pre> This will become: <pre><code>John's supply Cookies & Cakes 555 Main Street Littleville CA </code></pre> Some of the comments explain my choice of VBA statement but most do not. When you have to update a macro you wrote 12 months ago for new requirements, the few minutes you spent adding comments can save you hours finding your way around the code. You may not like my system of naming variables. Fine; develop your own. When you return to this macro in 12 months, an immediate understanding of the variables will save more time. <pre><code>Option Explicit Const WkshtSrcName As String = "Sheet1" ' \ Replace "Sheet1" and "Sheet2" Const WkshtDestName As String = "Sheet2" ' / with the names of your worksheets Const ColSupplier As String = "A" ' \ In Cells(R, C), C can be a Const ColProduct As String = "B" ' / number or a column identifier Const RowDataFirst As Long = 1 Sub MergeRowsForSameSupplier() Dim ColCrnt As Long ' \ Columns in source and destination are the Dim ColMax As Long ' / same so single variables are adequate. Dim RowDestCrnt As Long ' \ Rows in source and destination Dim RowSrcCrnt As Long ' | worksheets are different Dim RowSrcMax As Long ' / so need separate variables. Dim ProductCrnt As String Dim Join As String Dim SupplierCrnt As String Dim WkshtSrc As Worksheet Dim WkshtDest As Worksheet Set WkshtSrc = Worksheets(WkshtSrcName) Set WkshtDest = Worksheets(WkshtDestName) With WkshtSrc ' I consider this to be the easiest technique of identifying the last used ' row and column in a worksheet. Note: the used range includes trailing ' rows and columns that are formatted but otherwise unused or were used but ' aren't now so other techniques can better match what the user or the ' programmer usually mean by "used". ColMax = .UsedRange.Columns.Count RowSrcMax = .UsedRange.Rows.Count End With With WkshtDest .Cells.EntireRow.Delete ' Delete any existing contents End With RowDestCrnt = RowDataFirst For RowSrcCrnt = RowDataFirst To RowSrcMax With WkshtSrc SupplierCrnt = .Cells(RowSrcCrnt, ColSupplier).Value ProductCrnt = .Cells(RowSrcCrnt, ColProduct).Value End With If SupplierCrnt <> "" Then ' This is the first or only row for a supplier. ' Copy it to Destination worksheet. With WkshtSrc .Range(.Cells(RowSrcCrnt, 1), .Cells(RowSrcCrnt, ColMax)).Copy _ Destination:=WkshtDest.Cells(RowDestCrnt, 1) End With RowDestCrnt = RowDestCrnt + 1 ElseIf ProductCrnt = "" Then ' Both Supplier and Product cells are empty. With WkshtSrc If .Cells(RowSrcCrnt, Columns.Count).End(xlToLeft).Column = 1 And _ .Cells(RowSrcCrnt, 1).Value = "" And _ .Cells(RowSrcCrnt, Columns.Count).Value = "" Then ' If you do not understand why I have so many tests, ' experiment with Ctrl+Left ' Row empty so ignore it Else ' Don't know what to do with this error so give up Call MsgBox("Cells " & ColSupplier & RowSrcCrnt & " and " & _ ColProduct & RowSrcCrnt & " of worksheet " & _ WkshtSrcName & _ " are blank but the entire row is not blank", _ vbOKOnly + vbCritical, "Merge rows for same supplier") Exit Sub End If End With Else ' Supplier cell is empty. Product cell is not. ' Row RowDestCrnt-1 of the Destination worksheet contains the first row ' for this supplier or the result of merging previous rows for this ' supplier. If WkshtSrc.Cells(RowSrcCrnt + 1, ColSupplier).Value = "" And _ WkshtSrc.Cells(RowSrcCrnt + 1, ColProduct).Value <> "" Then ' The next row is for the same supplier but is not a blank row Join = "," Else ' This is last row for this supplier Join = " &" End If ' Add to list of products With WkshtDest .Cells(RowDestCrnt - 1, ColProduct).Value = _ .Cells(RowDestCrnt - 1, ColProduct).Value & Join & " " & _ ProductCrnt End With For ColCrnt = 1 To ColMax If ColCrnt = Cells(1, ColSupplier).Column Or _ ColCrnt = Cells(1, ColProduct).Column Then ' You may think (and you may be right) that the supplier and product ' will always be in the first two columns. But have seen the ' weirdest arrangements and make no assumptions ' Ignore this column Else If WkshtSrc.Cells(RowSrcCrnt, ColCrnt).Value = "" Then ' The most likely arrangement: the subsequent row has no ' value in this column. Nothing to do. ElseIf WkshtDest.Cells(RowDestCrnt - 1, ColCrnt).Value = "" Then ' This source row has a value in this column but [the] previous ' row[s] did not. ' Note: I use the copy statement because it copies formatting as ' well as the value which may be useful. WkshtSrc.Cells(RowSrcCrnt, ColCrnt).Copy _ Destination:=WkshtDest.Cells(RowDestCrnt - 1, ColCrnt) ElseIf WkshtSrc.Cells(RowSrcCrnt, ColCrnt).Value = _ WkshtDest.Cells(RowDestCrnt - 1, ColCrnt).Value Then ' Values match. Nothing to do. Else ' Values do not match. ' Don't know what to do with this error so give up. Call MsgBox("The value in cell " & ColNumToCode(ColCrnt) & _ RowSrcCrnt & " of worksheet " & WkshtSrcName & _ " does not match a value in an earlier row " & _ "for the same supplier", _ vbOKOnly + vbCritical, "Merge rows for same supplier") Exit Sub End If End If Next End If Next With WkshtDest .Cells.Columns.AutoFit End With End Sub Function ColNumToCode(ByVal ColNum As Long) As String ' Convert a column identifier (A, AA, etc.) to its number Dim Code As String Dim PartNum As Long ' Last updated 3 Feb 12. Adapted to handle three character codes. If ColNum = 0 Then ColNumToCode = "0" Else Code = "" Do While ColNum > 0 PartNum = (ColNum - 1) Mod 26 Code = Chr(65 + PartNum) & Code ColNum = (ColNum - PartNum - 1) \ 26 Loop End If ColNumToCode = Code End Function </code></pre>
Tags
Title
singulars
PostAcceptedAnswerId
1. This table or related slice is empty.
PostParentId
1. POMerge cells and delete duplicate data
 singulars
 PostTypePostTypeId
 PTQuestion
PostTypePostTypeId
1. PTAnswer
UserLastEditorUserId
1. This table or related slice is empty.
UserOwnerUserId
1. USTony Dallimore
plurals
PostLinksPostIdRelatedPostId
1. This table or related slice is empty.
PostLinksRelatedPostIdPostId
1. This table or related slice is empty.
PostsAcceptedAnswerId
1. This table or related slice is empty.
PostsParentIdCreationDate
1. This table or related slice is empty.
VotesPostIdCreationDate
1. This table or related slice is empty.
CommentsPostId
1. This table or related slice is empty.

Querying!

Guidance

A row detail

Detail views are divided into sections. All the information in the data section comes from columns in the selected row. The other sections display data from other, related rows.

Related data can be related in a to-one or a to-many fashion. Captions of data related in a to-many fashion link to a list view showing a filtered view of the table.

Try moving around until you find a non-empty to-many entry and click on the label to get to one. You can move back to the root by clicking on the database name in the header.