All
How can you assign multiple columns in a worksheet to a single key in a macro?
Please see below
Option Explicit<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Public Sub CombineRows2()<o></o>
<o></o>
Const sKeyCol As String = "C"<o></o>
Const sColIn As String = "K"<o></o>
Const sColOut As String = "T"<o></o>
Const iStartRow As Long = 2<o></o>
<o></o>
Dim ws As Worksheet<o></o>
Dim iLastRow As Long<o></o>
Dim iRow As Long<o></o>
Dim iRowOut As Long<o></o>
Dim sCustID As String<o></o>
Dim iMoved As Long<o></o>
<o></o>
Set ws = ThisWorkbook.Sheets("Sheet1")<o></o>
iLastRow = ws.Cells(ws.Rows.Count, sKeyCol).End(xlUp).Row<o></o>
ws.Range(sColOut & CStr(iStartRow) & ":" & sColOut & CStr(Rows.Count)).ClearContents<o></o>
<o></o>
iRow = iStartRow<o></o>
iMoved = 0<o></o>
sCustID = ""<o></o>
<o></o>
Do Until iRow > iLastRow<o></o>
If ws.Cells(iRow, sKeyCol) <> sCustID Then<o></o>
iRowOut = iRow<o></o>
sCustID = ws.Cells(iRow, sKeyCol)<o></o>
End If<o></o>
If Not IsEmpty(ws.Cells(iRow, sColIn)) Then<o></o>
If IsEmpty(ws.Cells(iRowOut, sColOut)) Then<o></o>
ws.Cells(iRowOut, sColOut) = ws.Cells(iRow, sColIn).Value<o></o>
iMoved = iMoved + 1<o></o>
End If<o></o>
End If<o></o>
iRow = iRow + 1<o></o>
DoEvents<o></o>
<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace>Loop</st1lace><o></o>
<o></o>
MsgBox "Done: " & CStr(iRow - iStartRow + 1) & " records read, " _<o></o>
& CStr(iMoved) & " fields moved." & Space(10), vbOKOnly + vbInformation<o></o>
<o></o>
End Sub
This macro assigns a single column to - sKeyCol. How can I change this to assign 2,3 or 4 columns to sKeyCol?
Thanks
How can you assign multiple columns in a worksheet to a single key in a macro?
Please see below
Option Explicit<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Public Sub CombineRows2()<o></o>
<o></o>
Const sKeyCol As String = "C"<o></o>
Const sColIn As String = "K"<o></o>
Const sColOut As String = "T"<o></o>
Const iStartRow As Long = 2<o></o>
<o></o>
Dim ws As Worksheet<o></o>
Dim iLastRow As Long<o></o>
Dim iRow As Long<o></o>
Dim iRowOut As Long<o></o>
Dim sCustID As String<o></o>
Dim iMoved As Long<o></o>
<o></o>
Set ws = ThisWorkbook.Sheets("Sheet1")<o></o>
iLastRow = ws.Cells(ws.Rows.Count, sKeyCol).End(xlUp).Row<o></o>
ws.Range(sColOut & CStr(iStartRow) & ":" & sColOut & CStr(Rows.Count)).ClearContents<o></o>
<o></o>
iRow = iStartRow<o></o>
iMoved = 0<o></o>
sCustID = ""<o></o>
<o></o>
Do Until iRow > iLastRow<o></o>
If ws.Cells(iRow, sKeyCol) <> sCustID Then<o></o>
iRowOut = iRow<o></o>
sCustID = ws.Cells(iRow, sKeyCol)<o></o>
End If<o></o>
If Not IsEmpty(ws.Cells(iRow, sColIn)) Then<o></o>
If IsEmpty(ws.Cells(iRowOut, sColOut)) Then<o></o>
ws.Cells(iRowOut, sColOut) = ws.Cells(iRow, sColIn).Value<o></o>
iMoved = iMoved + 1<o></o>
End If<o></o>
End If<o></o>
iRow = iRow + 1<o></o>
DoEvents<o></o>
<?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace>Loop</st1lace><o></o>
<o></o>
MsgBox "Done: " & CStr(iRow - iStartRow + 1) & " records read, " _<o></o>
& CStr(iMoved) & " fields moved." & Space(10), vbOKOnly + vbInformation<o></o>
<o></o>
End Sub
This macro assigns a single column to - sKeyCol. How can I change this to assign 2,3 or 4 columns to sKeyCol?
Thanks