Hi all! Got another question for ya'll! This is similar to the one eiloken helped me with earlier, but it's different enough I'd like to request help here as well.
As before, the workbook needs to be OS agnostic (on both Windows and Mac at least) and as Mac does not have access to Microsoft Scripting Runtime, I'm not able to use the script I got from somewhere else that uses Dictionaries.
I have a table that looks like this:
I would like a script that would be able to merge the rows based on column B. As you can see, there are two Sample 1s and two Sample 2s, with alternating empty spots in both rows. I would like the script to be able to merge them so it would look like this:
However, there's a catch: I would like the script to only check from row 61 onwards. Anything above row 61 should not be touched.
This is the script that I have been using:
Hope this won't be too difficult! Thanks!
As before, the workbook needs to be OS agnostic (on both Windows and Mac at least) and as Mac does not have access to Microsoft Scripting Runtime, I'm not able to use the script I got from somewhere else that uses Dictionaries.
I have a table that looks like this:
Batch | Sample | Analyte 1 | Analyte 2 | Analyte 3 | Analyte 4 | Analyte 5 | Analyte 6 | Analyte 7 | Analyte 8 | Analyte 9 | Analyte 10 | Analyte 11 | Analyte 12 | Analyte 13 | Analyte 14 |
Batch 1 | Sample 1 | <0.1 | <5 | <0.1 | 2.3 | 30.6 | 1.6 | <0.1 | 0.7 | <1 | 12.9 | ||||
Batch 1 | Sample 1 | 401 | 59.9 | 4 | 4050 | ||||||||||
Batch 1 | Sample 2 | <0.1 | <5 | <0.1 | 2.7 | 24.4 | 2 | <0.1 | 0.7 | <1 | 16.1 | ||||
Batch 1 | Sample 2 | 377 | 57.5 | 4.1 | 5190 |
I would like a script that would be able to merge the rows based on column B. As you can see, there are two Sample 1s and two Sample 2s, with alternating empty spots in both rows. I would like the script to be able to merge them so it would look like this:
Batch | Sample | Analyte 1 | Analyte 2 | Analyte 3 | Analyte 4 | Analyte 5 | Analyte 6 | Analyte 7 | Analyte 8 | Analyte 9 | Analyte 10 | Analyte 11 | Analyte 12 | Analyte 13 | Analyte 14 |
Batch 1 | Sample 1 | <0.1 | <5 | <0.1 | 2.3 | 30.6 | 401 | 1.6 | <0.1 | 59.9 | 0.7 | 4 | <1 | 4050 | 12.9 |
Batch 1 | Sample 2 | <0.1 | <5 | <0.1 | 2.7 | 24.4 | 377 | 2 | <0.1 | 57.5 | 0.7 | 4.1 | <1 | 5190 | 16.1 |
However, there's a catch: I would like the script to only check from row 61 onwards. Anything above row 61 should not be touched.
This is the script that I have been using:
VBA Code:
Sub mergeRows()
Const HDR As Long = 61 ' Header row
Const col As Long = 2 ' Column used for merging rows
Dim ws As Worksheet, lastRow As Long, i As Long
Set ws = ThisWorkbook.Worksheets("ALS Import")
lastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
Dim ac As New Dictionary, dc As New Dictionary
Dim itm As Variant, dRows As Range, d As Range, tr As String
If lastRow >= HDR Then
Application.ScreenUpdating = False
For i = HDR To lastRow ' Find duplicate values in the chosen column
tr = Trim(ws.Cells(i, col).Value)
If Len(tr) > 0 Then
If Not ac.Exists(tr) Then
ac.Add tr, i
Else
' If the key exists in the 'ac' dictionary, add to 'dc' for merging
If Not dc.Exists(ac(tr)) Then
dc.Add ac(tr), i
End If
End If
End If
Next i
For Each itm In dc ' Merge rows ---------------------------------------------------
' Combines rows where the chosen column values match
For i = 1 To ws.Cells(itm, ws.Columns.Count).End(xlToLeft).Column
If Len(Trim(ws.Cells(itm, i).Value)) = 0 Then
ws.Cells(itm, i).Value = ws.Cells(dc(itm), i).Value
End If
Next i
Next
For Each itm In dc ' Deletes the duplicate rows -----------------------------------
Set d = ws.Cells(dc(itm), col)
If dRows Is Nothing Then
Set dRows = d
Else
Set dRows = Union(dRows, d)
End If
Next
If Not dRows Is Nothing Then dRows.EntireRow.Delete
Application.ScreenUpdating = True
End If
End Sub