Scope of Multiple For each loops in Excel VBA

Question

I have a sheet with below data.

Category      | Amount    | Daily Charges | Misc Charges |  Vendor Charges
------------  |-----------| --------------|--------------|-------------------
Daily Charges |500,000.00 |               |              |       
--------------|-----------|---------------|--------------|-------------------
Misc Charges  | 500.00    |               |              |       
--------------|-----------| --------------|--------------|-------------------
Vendor Charges| 50,000.00 |               |              |

I need to fill column 3 (Daily Charges) , column 4 (Misc Charges) and column 5(Vendor Charges) as below using macros.

Category      | Amount    | Daily Charges | Misc Charges |  Vendor Charges
------------  |-----------| --------------|--------------|-------------------
Daily Charges |500,000.00 | 500,000.00    |     0        |       0
--------------|-----------|---------------|--------------|-------------------
Misc Charges  | 500.00    |     0         | ₹ 500.00     |       0
--------------|-----------| --------------|--------------|-------------------
Vendor Charges| 50,000.00 |     0         |      0       | 50,000.00

Please help.

I tried the below macro function but i'm unable to exit correctly from the scope of a for each loop .

Sub LoopInsert()

Dim tgt, final, rng, val, cell, cell2, cell3 As Range
Worksheets("Sheet1").Activate

Set rng = ActiveSheet.Range("A2", ActiveSheet.Range("A2").End(xlDown))
Set val = ActiveSheet.Range("B2", ActiveSheet.Range("B2").End(xlDown))
Set tgt = ActiveSheet.Range("C2", ActiveSheet.Range("C2").End(xlDown))


For Each cell In rng
   For Each cell2 In val

    If cell.Value = "Daily Charges" Then
     Exit For
       For Each cell3 In tgt
        cell3.Value = cell2.Value
        Exit For
        Next
     Else
     For Each cell3 In tgt
        cell3.Value = 0
        Exit For
        Next
    End If
Next
Next

End Sub

dgorti · Accepted Answer · 2017-01-11 07:44:14Z

1

You dont need a macro for this. You can do this with formulas

=IF($C$1 = A2, B2, 0)
=IF($D$1 = A2, B2, 0)
=IF($E$1=A2, B2, 0)

Paste them in C2, D2, E2 and then copy the formulas for the rest of the cells

Or as YowE3K points out you can use =IF(C$1=$A2,$B2,0) in cell C2, and copied to all the other cells (i.e. C2:E4)

edited Jan 11, 2017 at 7:44

answered Jan 11, 2017 at 6:20

dgorti

1,2802 gold badges15 silver badges23 bronze badges

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

Comments

user3598756 · Accepted Answer · 2017-01-11 09:34:24Z

sticking to VBA you can simplify your code and reduce running time

Option Explicit

Sub LoopInsert()
    Dim catColumnRng As Range, catRowRng As Range, colRng As Range, cell As Range

    With Worksheets("Sheet1")
        Set catColumnRng = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| store all "Category" not empty cells in column A from row 2 downwards
        Set catRowRng = .Range("C1", .Cells(1, .Columns.Count).End(xlToLeft)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| store all "Category" not empty cells in row 1 from column 3 rightwards

        For Each cell In catColumnRng '<--| loop through column A "Category" cells
            Set colRng = catRowRng.Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole) '<--| try finding corresponding text in row 1 "Category" cells
            If Not colRng Is Nothing Then .Cells(cell.Row, colRng.Column).Value = cell.Offset(, 1) '<--| if found then place the value
        Next cell
    End With
End Sub

Collectives™ on Stack Overflow

Scope of Multiple For each loops in Excel VBA

2 Answers 2

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related