Incrementing variables and repeat calculations

[Atvolpini]

Hello,

I am trying to work my way through a script that will take information from one column, concatenate it with another, repeat that for a section of cells, and then repeat all those steps with a different original field, incrementing until a blank field is reached. The data I have looks like so, the last group show in the middle of being processed:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Plate Number[/TD]
[TD]Well (H)[/TD]
[TD]Sample ID[/TD]
[/TR]
[TR]
[TD]500[/TD]
[TD]A1[/TD]
[TD]500A1[/TD]
[/TR]
[TR]
[TD]501[/TD]
[TD]A2[/TD]
[TD]500A2[/TD]
[/TR]
[TR]
[TD]502[/TD]
[TD]A3[/TD]
[TD]500A3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A1[/TD]
[TD]501A1
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A2[/TD]
[TD]501A2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A3[/TD]
[TD]501A3[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A1
[/TD]
[TD]502A1[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]A3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I recorded a macro to do the calculations, and copy the well (H) column values below the first set, to prepare for the next round of sample ID creation.

I am having trouble getting a variable assigned to the plate number to increment after finishing a round of calculations and problems with making each round of sample ID's begin below the previous round.

Here is what I am working with, but am unsure if I am even on the right track. Any help would be appreciated!

Sub All_DataSets()    Dim p As Long, r As Long
    p = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    Range("A1").Select
    For r = 1 To p
        Macro1
    Next
    r = r + 1
End Sub


Sub Macro1()
    Range("E2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R2C3&RC[-1]"
    ActiveCell.Select
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A92"), Type:= _
        xlFillDefault
    ActiveCell.Range("A1:A92").Select
    ActiveCell.Offset(0, -1).Range("A1:A92").Select
    ActiveCell.Offset(91, 0).Range("A1").Activate
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(92, 0).Range("A1").Select
End Sub

 

[JackDanIce]

Try following, note the cell address in the code, you may need to adjust to fit your data:

Sub TryMe()


    Dim x       As Long
    Dim y       As Long
    Dim i       As Long
    Dim arr1()  As Variant
    Dim arr2()  As Variant
    Dim arr3()  As Variant
    
    x = Range("C" & Rows.Count).End(xlUp).Row
    arr1 = Range("C2:C" & x).Value
    
    x = Range("H" & Rows.Count).End(xlUp).Row
    arr2 = Range("H2:H" & x).Value
        
    ReDim arr3(1 To (UBound(arr1, 1) * UBound(arr2, 1)), 1 To 1)
    i = LBound(arr3, 1)
    
    For x = LBound(arr1, 1) To UBound(arr1, 1)
        For y = LBound(arr2, 1) To UBound(arr2, 1)
            arr3(i, 1) = arr1(x, 1) & arr2(y, 1)
            i = i + 1
        Next y
    Next x
               
    Range("E2").Resize(UBound(arr3, 1), UBound(arr3, 2)).Value = arr3
    
    Erase arr1: Erase arr2: Erase arr3
    
End Sub

 

[Atvolpini]

Thank you very much! I changed the cell references and this worked perfectly. If you are willing I have a couple questions regarding the code, just to satisfy my own curiosity:

1. What is the purpose of the "& x" section of the array definitions?

2. why are the upper and lower bounds of each array the same?

[COLOR=#333333] [/COLOR][COLOR=#333333]For x = LBound(arr1, 1) To UBound(arr1, 1)[/COLOR]
[COLOR=#333333]        For y = LBound(arr2, 1) To UBound(arr2, 1)[/COLOR]

 

[JackDanIce]

You're welcome, glad it's resolved. Comments:

1. If x = 5 then ("A" & x) is "A5" due to concatenation of "A" and 5 into a string "A5"

Range takes a string argument for a cell object so Range("A5") is cell A5 on the sheet.

2. They may not be the same value, but that is how to address the lower bound and upper bound of the array.

 

[Atvolpini]

Hi JackDanIce,

I have been happily using your code for the last couple months, and just noticed something I wanted to ask about. When there is only 1 cell with data in the x range, the error code "Run time error 13, Type Mismatch" displays. I almost never have only 1 cell that has data, but do you know why that might be happening?

 

[JackDanIce]

n/a

 

[JackDanIce]

This assumes you have headers in row 1 and at least values in C2 and H2, try:

Sub TryMe()

    Dim x       As Long
    Dim y       As Long
    Dim i       As Long
    Dim arr     As Variant
    Dim arr1()  As Variant
    Dim arr2()  As Variant
    Dim arr3()  As Variant
    
    Const MYEND As String = "@@"
    
    ReDim arr(1 To 2)
        
    arr(1) = Cells(Rows.Count, 3).End(xlUp).Row
    arr(2) = Cells(Rows.Count, 8).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    Cells(arr(1) + 1, 3).Value = MYEND
    Cells(arr(2) + 1, 8).Value = MYEND
    
    arr1 = Cells(2, 3).Resize(arr(1)).Value
    arr2 = Cells(2, 8).Resize(arr(2)).Value
    
    ReDim arr3(1 To (UBound(arr1, 1) * UBound(arr2, 1)), 1 To 1)
    i = LBound(arr3, 1)

    For x = LBound(arr1, 1) To UBound(arr1, 1)
        For y = LBound(arr2, 1) To UBound(arr2, 1)
            If InStr(arr1(x, 1) & arr2(y, 1), MYEND) Then Exit For
            arr3(i, 1) = arr1(x, 1) & arr2(y, 1)
            i = i + 1
        Next y
    Next x
              
    Range("E2").Resize(UBound(arr3, 1), UBound(arr3, 2)).Value = arr3
    Cells(arr(1) + 1, 3).ClearContents
    Cells(arr(2) + 1, 8).ClearContents
    
    Application.ScreenUpdating = True
    
    Erase arr: Erase arr1: Erase arr2: Erase arr3
    
End Sub

 

[Atvolpini]

Sorry for no response! This also works great. Im trying to learn more about VBA so I can do more without relying on the forums here. May I ask a couple questions about the code to try and better understand it?