VBA Do Until Loop Inside For Loop

[VBA_Padawan_37]

Hello,

First time poster long time lurker here! I have recently started getting into VBA and am struggling with a spreadsheet I am working on currently. I have a matrix filled out with either an X or an A in each cell (my rows are IDs and columns are Dates). What I want to do is, for each row, concatenate the values in all of the populated columns (x or a) and return the value in the first column without any data.

I can get the concatenate piece to work just fine, but when I try to wrap it in a For/Next loop it's still only doing the first row. Can you please take a look at the below code and let me know what I'm doing wrong? Number of Rows and Columns can vary from sheet to sheet.

The ultimate goal is to identify which rows have identical values for all of the columns and then find a way to signify rows that are the same (in the example, have all of the same values in columns B through AB). I would like to be able to highlight them but having another column which groups them by assigning a number to the various groups works as well.

Current Code:

Sub Xmatrix_Concatenate()
'
' Xmatrix_Concatenate Macro
'
'
'
Dim s As String
Dim WS As Worksheet
Dim LastColumn As Long
Dim LastRow As Long

Set WS = ActiveWorkbook.ActiveSheet
LastColumn = WS.Cells(1, WS.Columns.Count).End(xlToLeft).Column
LastRow = Range("A" & Rows.Count).End(xlUp).Row

For r = 2 To LastRow Step 1
Do Until ActiveCell.Column = LastColumn + 1
If ActiveCell.Offset(0, 1).Value <> "" Then s = s & ActiveCell.Value & "," Else s = s & ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Value = s
Next r

End Sub


Thank you all for your help!

 

[cerfani]

readability

[COLOR=#333333]Sub Xmatrix_Concatenate()[/COLOR]
[COLOR=#333333]'[/COLOR]
[COLOR=#333333]' Xmatrix_Concatenate Macro[/COLOR]
[COLOR=#333333]'[/COLOR]
[COLOR=#333333]'[/COLOR]
[COLOR=#333333]'[/COLOR]
[COLOR=#333333]    Dim s As String[/COLOR]
[COLOR=#333333]    Dim WS As Worksheet[/COLOR]
[COLOR=#333333]    Dim LastColumn As Long[/COLOR]
[COLOR=#333333]    Dim LastRow As Long[/COLOR]

[COLOR=#333333]    Set WS = ActiveWorkbook.ActiveSheet[/COLOR]
[COLOR=#333333]    LastColumn = WS.Cells(1, WS.Columns.Count).End(xlToLeft).Column[/COLOR]
[COLOR=#333333]    LastRow = Range("A" & Rows.Count).End(xlUp).Row[/COLOR]

[COLOR=#333333]    For r = 2 To LastRow [/COLOR][COLOR=#008000]'Step 1 ... step 1 is default, just omit[/COLOR]
[COLOR=#333333]        Do Until ActiveCell.Column = LastColumn + 1[/COLOR]
[COLOR=#333333]            If ActiveCell.Offset(0, 1).Value <> "" Then s = s & ActiveCell.Value & "," Else s = s & ActiveCell.Value[/COLOR]
[COLOR=#333333]            ActiveCell.Offset(0, 1).Select[/COLOR]
[COLOR=#333333]        Loop[/COLOR]
[COLOR=#333333]        ActiveCell.Value = s[/COLOR]
[COLOR=#333333]    Next r[/COLOR]

[COLOR=#333333]End Sub[/COLOR]

i suggest you dont use active cell and start referencing specific ranges and objects... unless you are recording, there really is no reason to reference active anything... of course it has it's uses but in general you shouldnt ever need to use those.

anytime you enter a new scope of code (like going inside an IF or a Loop) you should tab over or put 4 spaces

if i had to take a wild guess your Do Until condition is true when it shouldnt be so you have to debug it

 

[JoeMo]

If you post some sample data in a form that can be copied and pasted to an Excel sheet, showing your expected results, you will improve your chances of getting some help. Generally, writing code that depends on the active cell location incurs the risk that the user will not have the correct cell selected prior to running the code.

 

[VBA_Padawan_37]

Thank you cerfani for the guidelines/assistance. I'm still trying to learn posting on a message board apparently as well!

 

[VBA_Padawan_37]

JoeMo/cerfani,

Please see the below sample of what the excel file looks like. Number of rows and columns can vary from sheet to sheet. How would you alter the code I currently have in order to achieve the output in column F of the below sample?

Example2

*	A	B	C	D	E	F
1	Entry Date/ID	28-Apr	5-May	12-May	19-May	*
2	47210	x	a	x	x	x,a,x,x
3	96992	x	a	a	x	x,a,a,x
4	29499	x	x	x	x	x,x,x,x
5	18841	x	a	a	x	x,a,a,x
6	62799	x	x	a	x	x,x,a,x

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:126.22px;"><col style="width:18.22px;"><col style="width:18.22px;"><col style="width:18.22px;"><col style="width:18.22px;"><col style="width:67.11px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

 

[JoeMo]

JoeMo/cerfani,

Please see the below sample of what the excel file looks like. Number of rows and columns can vary from sheet to sheet. How would you alter the code I currently have in order to achieve the output in column F of the below sample?

Example2

*	A	B	C	D	E	F
1	Entry Date/ID	28-Apr	5-May	12-May	19-May	*
2	47210	x	a	x	x	x,a,x,x
3	96992	x	a	a	x	x,a,a,x
4	29499	x	x	x	x	x,x,x,x
5	18841	x	a	a	x	x,a,a,x
6	62799	x	x	a	x	x,x,a,x

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Try this:

Sub PADAWAN()
Dim R As Range, i As Long
Set R = Range("A1:E" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
Columns("F").ClearContents
Set R = R.Offset(1, 1).Resize(R.Rows.Count - 1, R.Columns.Count - 1)
For i = 1 To R.Rows.Count
    R.Cells(i, 5).Value = Join(Application.Transpose(Application.Transpose(Range(R.Rows(i).Cells(1, 1), R.Rows(i).Cells(1, 4)))), ",")
Next i
Application.ScreenUpdating = True
End Sub

 

[VBA_Padawan_37]

Thank you Joe!

This works for the above sample, but how can the provided code be altered so that it is flexible for any number of date columns? For example, the above sample has 4 date columns, but the next spreadsheet might have 9 or 15 date columns. Thank you again for all of your help!

 

[JoeMo]

Thank you Joe!

This works for the above sample, but how can the provided code be altered so that it is flexible for any number of date columns? For example, the above sample has 4 date columns, but the next spreadsheet might have 9 or 15 date columns. Thank you again for all of your help!

You are welcome. Here's a modification (untested) that should handle multiple columns using the same layout you showed us in post #5.

Sub PADAWAN()
Dim R As Range, i As Long
Set R = Range("A1").CurrentRegion
Application.ScreenUpdating = False
Columns(R.Columns.Count + 1).ClearContents
Set R = R.Offset(1, 1).Resize(R.Rows.Count - 1, R.Columns.Count - 1)
For i = 1 To R.Rows.Count
    R.Cells(i, R.Columns.Count + 1).Value = Join(Application.Transpose(Application.Transpose(Range(R.Rows(i).Cells(1, 1), R.Rows(i).Cells(1, 4)))), ",")
Next i
Application.ScreenUpdating = True
End Sub

 

[VBA_Padawan_37]

Thank you Joe, this works! Only thing I needed to change was the "4" value to R.Columns.Count in the above code. Thank you very much for your help, this is great!