Incrementing variables and repeat calculations

Atvolpini

New Member
Joined
Oct 26, 2017
Messages
15
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:

Plate NumberWell (H)Sample ID
500A1500A1
501A2500A2
502A3500A3
A1501A1
A2501A2
A3501A3
A1
502A1
A2
A3

<tbody>
</tbody>

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!

Code:
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
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Try following, note the cell address in the code, you may need to adjust to fit your data:
Rich (BB code):
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
 
Upvote 0
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?
Code:
[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]
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
This assumes you have headers in row 1 and at least values in C2 and H2, try:
Code:
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
 
Last edited:
Upvote 0
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?
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,267
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top