Loops

[tomburns1987]

Hi guys,

I have written some VBA code where i input a nominal code and then the code does what I need it to do.

I have several tabs in this workbook and on each tab there are serveral nominal codes where the data gets pasted underneath.

Currently I use an inputbox and manually type in one code at a time and then move on to the next.

My question is this - Is there a way I can input a list of codes at the start and loop the code until it has gone through each one OR can I get it to work through a list of codes and pick those out to use in the variables inside the code?

(i have to use 2 codes at the moment, first one finds a starting point for a formula copy down)

Code below

Thanks.

Sub findactivecell()
Dim Nominal1 As Integer

Nominal1 = InputBox("Please enter Nominal 1", "Nominals", "6200")
Set result = Cells.Find(What:=Nominal1)
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 11).Select
    Call Automate
    
 
End Sub

Sub Automate()
'Dims
Dim Nomcount As Integer
Dim myrange As Range
Dim Nominal1 As Integer
Dim sheetname As String

'Inputs
sheetname = ActiveSheet.Range("A1").Value
Nominal1 = InputBox("Please enter Nominal 1", "Nominals", "6200")
 
'Sets
Set myrange = Sheets("Dump").Columns(1)
Set result = Sheets(sheetname).Cells.Find(What:=Nominal1)
Set Resultdump = Sheets("Dump").Cells.Find(What:=Nominal1)
Set Rowval = Sheets(sheetname).Range("L5:EX5")
 
'Variables

Nomcount = Application.WorksheetFunction.CountIf(myrange, Nominal1)
Lastrow = Worksheets("Dump").Cells(Rows.Count, 1).End(xlUp).Row
lastcol = Left(Sheets(sheetname).Range("A3:EX3").Find("Check").Address, 3)
Colcount = ActiveCell.Row
Autofillrange = "L" & Colcount & ":" & lastcol & Colcount
Autofillrange2 = "L" & (Colcount + Nomcount + 1) & ":" & lastcol & (Colcount + Nomcount + 1)

'Actions

    Sheets(sheetname).Select
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Rows("2:" & Nomcount + 1).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 11).Select
    With ActiveSheet
    Range(ActiveCell.Address & ":" & lastcol & Colcount).Select
    End With
    Selection.AutoFill Destination:=Range(Autofillrange, Autofillrange2), Type:=xlFillDefault
 

    Sheets("Dump").Activate
    Range("A2:L" & Lastrow).Select
    Selection.AutoFilter
    Worksheets("Dump").Range("A1").AutoFilter Field:=1, Criteria1:=Nominal1
    Range("A:A").EntireColumn.Hidden = True
    Selection.Offset(1, 0).Select
    Selection.Copy
    
    
    Sheets(sheetname).Select
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1).Select
    ActiveSheet.Paste
    With Range("G:K")
    .HorizontalAlignment = xlCenter
    .Style = "Comma"
    End With
    With Range("A:A")
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    End With
    
    Sheets("Dump").Activate
    Range("A:A").EntireColumn.Hidden = False
    Sheets("Dump").AutoFilterMode = False
    Worksheets(sheetname).Activate
    
End Sub

 

[Jeffrey Lopez]

Welcome to the Mr. Excel Message Board!

It sounds like you are looking for an Array loop. Here is how it works:

First you have to tell it how many "Nominal"s you have... in my example, I just used 5...

Dim Nominal(1 To 5) As Integer

This is just saying that you will have 5 numbers defined as Nominal(1), Nominal(2), Nominal(3) and so on...

Then we start the loop....

For i = 1 To 5

This just means that you are are going substitute i each one of the variables 1 to 5.

Next we are going to set each one of the Nominal(i) for a value...

Nominal(i) = InputBox("Please enter Nominal " & i, "Nominals", "6200")

Then we just need to replace each on the Nominal1 with the values that we are setting...

Set result = Cells.Find(What:=Nominal(i))
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 11).Select

Then we just loop back to the Next i and do it again...

 Next i

Once we have all the values set, then we can call your Automate...

So your "Automate" should be set up about the same... I have not tested it, but see if this works for you...

PLEASE BACK UP YOUR EXCEL WORKBOOK BEFORE RUNNING THIS MACRO!

For i = 1 To 5
Nominal(i) = InputBox("Please enter Nominal " & i, "Nominals", "6200")
Set result = Cells.Find(What:=Nominal(i))
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 11).Select
Next i
 
Call Automate


End Sub

Sub Automate()
'Dims
Dim Nomcount As Integer
Dim myrange As Range
Dim Nominal(1 To 5) As Integer
Dim sheetname As String


For i = 1 To 5
'Inputs
sheetname = ActiveSheet.Range("A1").Value
Nominal(i) = InputBox("Please enter Nominal " & i, "Nominals", "6200")
 
'Sets
Set myrange = Sheets("Dump").Columns(1)
Set result = Sheets(sheetname).Cells.Find(What:=Nominal(i))
Set Resultdump = Sheets("Dump").Cells.Find(What:=Nominal(i))
Set Rowval = Sheets(sheetname).Range("L5:EX5")
 
'Variables


Nomcount = Application.WorksheetFunction.CountIf(myrange, Nominal(i))
Lastrow = Worksheets("Dump").Cells(Rows.Count, 1).End(xlUp).Row
lastcol = Left(Sheets(sheetname).Range("A3:EX3").Find("Check").Address, 3)
Colcount = ActiveCell.Row
Autofillrange = "L" & Colcount & ":" & lastcol & Colcount
Autofillrange2 = "L" & (Colcount + Nomcount + 1) & ":" & lastcol & (Colcount + Nomcount + 1)


'Actions


    Sheets(sheetname).Select
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Rows("2:" & Nomcount + 1).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 11).Select
    With ActiveSheet
    Range(ActiveCell.Address & ":" & lastcol & Colcount).Select
    End With
    Selection.AutoFill Destination:=Range(Autofillrange, Autofillrange2), Type:=xlFillDefault
 


    Sheets("Dump").Activate
    Range("A2:L" & Lastrow).Select
    Selection.AutoFilter
    Worksheets("Dump").Range("A1").AutoFilter Field:=1, Criteria1:=Nominal(i)
    Range("A:A").EntireColumn.Hidden = True
    Selection.Offset(1, 0).Select
    Selection.Copy
    
    
    Sheets(sheetname).Select
    result.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1).Select
    ActiveSheet.Paste
    With Range("G:K")
    .HorizontalAlignment = xlCenter
    .Style = "Comma"
    End With
    With Range("A:A")
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    End With
    
    Sheets("Dump").Activate
    Range("A:A").EntireColumn.Hidden = False
    Sheets("Dump").AutoFilterMode = False
    Worksheets(sheetname).Activate
    
Next i


End Sub

PLEASE BACK UP YOUR EXCEL WORKBOOK BEFORE RUNNING THIS MACRO!

 

[tomburns1987]

Hi Jeffery,

Thank you so much for taking the time to look at this for me and your very thorough instructions. I didn't realise that anybody had responded so thanks again!

I will try and build this into the macro and let you know how I get on.

Tom