Excel 2010 VBA scripting

Question

I’m a complete newbie with VBA but have managed to cobble together the following which works fine for my worksheet where I have assigned the code to a command button. My problem is that my worksheet has in excess of 3000 rows and I don’t really want to create 3000 buttons.

My current thinking would be to have a script search a range of cells for a specific condition (i.e. TRUE) then run my original code as a subscript for each cell that matches the condition. I have tried creating a loop to match the condition being searched but don't know how to set the result(s) as an active cell.

Could anyone give me some pointer on how to achieve this or propose a better solution? Thanks.

Sub Send_FWU_to_E_Drive()

Dim aTemp As String
Dim bTemp As String
Dim cTemp As String
Dim dTemp As String
Dim eTemp As String
Dim subdir As String

aTemp = "c:\test\"
bTemp = "E:\romdata\"
cTemp = ActiveCell.Offset(, -5) & ".fwu"
dTemp = ActiveWorkbook.path
eTemp = "\Firmware files"
subdir = "\Firmware Files\" & ActiveCell.Offset(, -5) & "\" & ActiveCell.Offset(, -5) & ".fwu"

MsgBox "The path of the active workbook is " & dTemp & subdir

If Dir(dTemp & subdir) = "" Then
MsgBox "Please check the file and ensure it is suitable for firmware updating with an SD card."
Exit Sub
End If

MsgBox "The file " & cTemp & " is being copied to " & bTemp

If Dir("e:\romdata", vbDirectory) = "" Then MkDir "E:\romdata"

If Dir(bTemp & "nul") = "" Then
MsgBox "The Destination Directory is missing, please ensure your SD Card is formatted, mapped as drive E and has a romdata directory."
Exit Sub

End If

FileCopy dTemp & subdir, bTemp & cTemp

End Sub

Doug Glancy · Accepted Answer · 2013-04-15 15:25:29Z

2

First modify your function to accept a range argument, which we'll call cell:

Sub Send_FWU_to_E_Drive(cell as Excel.Range)

Then change all the ActiveCell references in that Sub to cell.

The sub below loops through each cell in column B of the Active sheet and, if it's TRUE, calls your routine with the cell in column A of that row. So your offsets in the code in Send_FWU_to_E_Drive are all relative to the cell in column A. This code is untested, but should be close:

Sub Test
Dim Cell as Excel.Range
Dim LastRow as Long

With ActiveSheet
    LastRow = .Range("A" & .Rows.Count).End(xlup).Row
    For Each Cell in .Range("B2:B" & LastRow) 'Search for TRUE in column B
        If Cell.Value = TRUE Then
            Send_FWU_to_E_Drive cell.Offset(0,-1) 'Column A Cell
        End If
    Next Cell
End With
End Sub

EDIT: Per @Siddharth's suggestion, here's a Find/FindNext version:

Sub Test()
Dim cell As Excel.Range
Dim LastRow As Long
Dim SearchRange As Excel.Range
Dim FirstFindAddress As String

With ActiveSheet
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set SearchRange = .Range("B2:B" & LastRow)  'Search for TRUE in column B
    Set cell = SearchRange.Find(what:=True, after:=SearchRange.Cells(1))
    If Not cell Is Nothing Then
        FirstFindAddress = cell.Address
        Send_FWU_to_E_Drive cell.Offset(0, -1)
        Do
            Send_FWU_to_E_Drive cell.Offset(0, -1)
            Set cell = SearchRange.FindNext(after:=cell)
        Loop While Not cell Is Nothing And cell.Address <> FirstFindAddress
    End If
End With
End Sub

edited Apr 15, 2013 at 15:25

answered Apr 15, 2013 at 13:43

Doug Glancy

27.5k6 gold badges72 silver badges118 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Siddharth Rout Over a year ago

+ 1 for suggesting to pass a cell to the function. Also perhaps .Find instead of Looping? siddharthrout.com/2011/07/14/find-and-findnext-in-excel-vba

user2282503 Over a year ago

Thanks for your help, it's made my project so much easier.

Collectives™ on Stack Overflow

Excel 2010 VBA scripting

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related