Help with VBA ARRAY

[Ppessina]

I am relatively new to VBA and I am trying to create an array to compare columns in a worksheet. for example, I want to look through a column with unknown rows and every time I find the word "AUTH" I want to then look at its value which is in another column and paste it to an empy tolumn in the same row.

Another example is I want to look at more than one column and compare them. Ex) if row says "AUTH" and then another column (same row) says "CANCELLED" then again return value found in another column to blank column.


Thank you for your help. I hope this isnt completely confusing. I guess i am just having a lot of trouble understanding how to compare arrays or even set them up to be compared.

[Solus Rankin]

I'm not sure you even need an array. Can you paste a sample workbook with a before and after example of what you would like to see?

[Ppessina]

I am trying to set it up to find the specific rows and columns I am looking for because if extra columns are deleted I want it to continue to run without issue

[Ppessina]

attahced is example. This will contain roughly 25k lines

[Ppessina]

Here is an example of some of the code I have created. Problem is it is looping too much and takes forever

 Sub CreateSheetsWithNames()
 

sheets("master").Cells.EntireColumn.Hidden = False



    Dim firstrow As Range
 
    Dim rcell As Range
        Dim rcell2 As Range
            Dim rcell3 As Range
                   Dim rcell4 As Range
                        Dim rcell5 As Range
                            Dim rcell6 As Range
                                Dim rcell7 As Range
                
                                        Dim rcell9 As Range
                                            Dim rcell10 As Range
                            
                   
    Dim bcell As Range
      
    Dim strnsearch As String
     
    
    Dim lastrow As Long
        Dim lastcolumn1 As Long
   
    Dim y As Integer
 With sheets("Master")
If .Range("b1") = vbNullString Then
    lastcolumn1 = .Range("b1").End(xlDown).End(xlToRight).Column
        Else
        
lastcolumn1 = .Range("b1").End(xlToRight).Column
    End If
    


If .Range(Cells(1, lastcolumn1).Address) = "" Then
    Set firstrow = .Range(Cells(1, lastcolumn1).Address).End(xlDown).Offset(0, 1)
            Else:  Set firstrow = .Range(Cells(1, lastcolumn1).Offset(0, 1).Address)
                End If
                
For y = firstrow.Row To .Range("A100000").End(xlUp).Row
 
strnsearch = "Document Type"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
 If Not bcell Is Nothing Then
    bcellletter = Col_Letter(bcell.Column)
         Else
            MsgBox ("Please designate column 'Document Type'")
                End
                    End If
                    
                    
                    
strnsearch = "Expenses by LOA"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not bcell Is Nothing Then
   bcellletter2 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Expenses by LOA'")
                 End
                    End If



strnsearch = "Document Create Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not bcell Is Nothing Then
    bcellletter3 = Col_Letter(bcell.Column)
         Else
            MsgBox ("Please designate column 'Document Create Date'")
             End
                    End If




strnsearch = "Departure Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
    If Not bcell Is Nothing Then
    bcellletter4 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Departure Date'")
                 End
                    End If
            
            
            
            
strnsearch = "Last AO Approved Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
           
  If Not bcell Is Nothing Then
    bcellletter5 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Last AO Approved Date'")
                 End
                    End If
           
                 
           
strnsearch = "Total Trip Expenses"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
             
    If Not bcell Is Nothing Then
    bcellletter6 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Total Trip Expenses'")
                 End
                    End If
             
             
             
             
             
strnsearch = "TANum"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
   If Not bcell Is Nothing Then
    bcellletter7 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'TANum'")
                 End
                    End If
            
            
strnsearch = "Return Date"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

If Not bcell Is Nothing Then
    bcellletter9 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Return Date'")
                 End
                    End If


strnsearch = "Current Status"
    Set bcell = .UsedRange.Find(What:=strnsearch, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

                    
                                        
If Not bcell Is Nothing Then
    bcellletter10 = Col_Letter(bcell.Column)
        Else
            MsgBox ("Please designate column 'Current Status'")
                 End
                    End If
                    
                    
LastLetter = Col_Letter(lastcolumn1)
clearletter = Col_Letter(firstrow.Column)


firstrow.Value = "AUTHORIZATIONS"
firstrow.Offset(0, 1).Value = "VOUCHERS"
firstrow.Offset(0, 2).Value = "LOCAL VOUCHERS"
firstrow.Offset(0, 3).Value = "Doc create date after departure date"
firstrow.Offset(0, 4).Value = "Travel Notice Given"
firstrow.Offset(0, 5).Value = "Voucher Create date over 5 days from Return"
firstrow.Offset(0, 6).Value = "Last AO approved Date before  Doc Create Date"
firstrow.Offset(0, 7).Value = "Is Cancelled Trip Zero'd Out?"
firstrow.Offset(0, 8).Value = "Unliquidated Amount"
firstrow.Offset(0, 9).Value = "Unliquidated %"
Range(firstrow, firstrow.Offset(0, 9)).Font.Bold = True


For Each rcell In sheets("master").Range(bcellletter & y)
For Each rcell2 In sheets("master").Range(bcellletter2 & y)
If rcell.Value = "AUTH" Then
    .Range(LastLetter & y).Offset(0, 1).Value = .Range(bcellletter2 & y).Value
        End If
If rcell.Value = "VCH" Then
    .Range(LastLetter & y).Offset(0, 2).Value = .Range(bcellletter2 & y).Value
        End If
If rcell.Value = "LVCH" Then
    .Range(LastLetter & y).Offset(0, 3).Value = .Range(bcellletter2 & y).Value
        End If
        Next
        Next
        
For Each rcell In sheets("master").Range(bcellletter & y)
For Each rcell3 In sheets("master").Range(bcellletter3 & y)
For Each rcell4 In sheets("master").Range(bcellletter4 & y)
If rcell.Value = "AUTH" And rcell4.Value < rcell3.Value Then
    .Range(LastLetter & y).Offset(0, 4).Value = "Error"
        End If
        Next
        Next
        Next
        


For Each rcell In sheets("master").Range(bcellletter & y)
For Each rcell6 In sheets("master").Range(bcellletter6 & y)
For Each rcell10 In sheets("master").Range(bcellletter10 & y)
If rcell.Value = "AUTH" Then
    If rcell6.Value > 0 And rcell10.Value = "CANCELLED" Then
        .Range(LastLetter & y).Offset(0, 7).Value = "Error"
            End If
                End If
                Next
                Next
                Next
                 
                 
                 
For Each rcell In sheets("master").Range(bcellletter & y)
For Each rcell3 In sheets("master").Range(bcellletter3 & y)
For Each rcell9 In sheets("master").Range(bcellletter9 & y)
If rcell.Value = "VCH" Or rcell.Value = "LVCH" Then
    If rcell3.Value - rcell9.Value > 5 Then
        .Range(LastLetter & y).Offset(0, 6).Value = "Error"
            End If
                End If
                Next
                Next
                Next
                                            
                                            
 For Each rcell2 In sheets("master").Range(bcellletter2 & y)
For Each rcell7 In sheets("master").Range(bcellletter7 & y)
If rcell7.Value = " " Or rcell7.Value = vbNullString And rcell2.Value > 0 Then
    .Range(LastLetter & y).Offset(0, 8).Value = .Range(bcellletter2 & y)
        .Range(LastLetter & y).Offset(0, 8).NumberFormat = "$#,##0.00"
            End If
            Next
            Next
                    
 For Each rcell In sheets("master").Range(bcellletter & y)
For Each rcell3 In sheets("master").Range(bcellletter3 & y)
For Each rcell4 In sheets("master").Range(bcellletter4 & y)
If rcell.Value = "AUTH" Then
    sheets("Master").Range(LastLetter & y).Offset(0, 5).Value = rcell4.Value - rcell3.Value
        sheets("Master").Range(LastLetter & y).Offset(0, 5).HorizontalAlignment = xlCenter
            End If
            Next
            Next
            Next
            
Next
End With
End Sub

[Solus Rankin]

The code you posted seems to do significantly more than what you asked for in your first post. This is where a workbook with a before and after example becomes so useful.

if extra columns are deleted I want it to continue to run without issue

This should be no problem, usually if you are deleting rows you can loop backwards and the loop is not effected.

[Ppessina]

Sorry. I know that code was really long. What I am looking for is an example array for one of those loops. If I can get an idea of how to set it up I think ill be able to adapt it for the rest.

[Solus Rankin]

Well if I take what your OP asks for literally then this:

Sub test()

Dim l As Long
Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For l = 1 To lRow
    If UCase(Range("A" & l).Value) = "AUTH" Then
        If UCase(Range("B" & l).Value) = "CANCELLED" Then
            Cells(l, Columns.Count).End(xlToLeft).Offset(, 1).Value = Range("C" & l).Value
        Else:
            Cells(l, Columns.Count).End(xlToLeft).Offset(, 1).Value = Range("D" & l).Value
        End If
    End If
Next l

End Sub

Looks in column A for AUTH. If AUTH is found in A and CANCELLED is found in B of same row then it copies Column C of same row to the first empty cell in that row. If cancelled is NOT found in column b then it copies column D of the same row to the first empty cell in that row.

Clear as mud?

[Kenneth Hobson]

It would probably be easier to do a multi-find and then iterate the found range.

'xld, http://www.vbaexpress.com/forum/showthread.php?t=38802, see module, mDeleteRowsFromBottomUp

' Chip Pearson, http://www.cpearson.com/excel/FindAll.aspx

'Kenneth, http://www.vbaexpress.com/forum/showthread.php?t=38802
Sub Test_FoundRanges()
  Dim findRange As Range, findString As String, foundRange As Range
  Dim r As Range, i As Long
  
  On Error GoTo EndNow:
  'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
  SpeedOn
  
  Set findRange = ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
  findString = "Allocation"
  Set foundRange = FoundRanges(findRange, findString)
  If foundRange Is Nothing Then GoTo EndNow
  
  'If Not foundRange Is Nothing Then MsgBox foundRange.Address 'Note that range is in reverse order
  'If Not foundRange Is Nothing Then foundRange.EntireRow.Delete
  'For i = i to foundRange.Areas.Count
  '  foundRange.Areas(i).EntireRow.Delete
  'Next i
  
EndNow:
  SpeedOff
End Sub

Function FoundRanges(fRange As Range, fStr As String) As Range
    Dim objFind As Range
    Dim rFound As Range, FirstAddress As String
     
    With fRange
        Set objFind = .Find(what:=fStr, After:=fRange.Cells((fRange.Rows.Count), fRange.Columns.Count), _
        LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=True)
        If Not objFind Is Nothing Then
            Set rFound = objFind
            FirstAddress = objFind.Address
            Do
                Set objFind = .FindNext(objFind)
                If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
            Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
        End If
    End With
    Set FoundRanges = rFound
End Function

[Ppessina]

Thanks for the replies. Sorry I was slow in getting an example ready

[Ppessina]

Thank again