Finding non-zero values and populating into different tab

[Nova]

Hi!
I was wondering if you can help me. I want to create some sort of lookup which grabs ONLY the cells which have non zero numbers from the "CHANGES" tab. It would then list those numbers in the "EXPLANATIONS" (row d - t).
I also need to be able to populate corresponding cost center (collumn A) and account ( collum B) in the explaination tab with a found value.

Please the attachment.

I would assume I need to create a loop, but I'm not sure how to organize it.

[Jacob Hilderbrand]

Try this macro:


Option Explicit

Sub Macro1()
Dim i As Long
Dim LastRow As Long
Dim TargetRange As Range
Dim Cel As Range
Dim DelRow As Boolean
Dim DelRange As Range
Sheets("Explanations").Range("A7:IV65536").ClearContents
LastRow = Sheets("Changes").Range("A65536").End(xlUp).Row
Sheets("Changes").Range("A7:B" & LastRow).Copy Destination:= _
Sheets("Explanations").Range("A7")
Sheets("Changes").Range("C7:S" & LastRow).Copy Destination:= _
Sheets("Explanations").Range("D7")
LastRow = Sheets("Explanations").Range("A65536").End(xlUp).Row
For i = LastRow To 7 Step -1
Set TargetRange = Sheets("Explanations").Range("D" & i & ":T" & i)
DelRow = True
For Each Cel In TargetRange
If Cel.Value <> 0 And Cel.Value <> "" Then
DelRow = False
Exit For
End If
Next
If DelRow = True Then
If DelRange Is Nothing Then
Set DelRange = Sheets("Explanations").Range("A" & i)
Else
Set DelRange = Union(DelRange, Sheets("Explanations").Range("A" & i))
End If
End If
Next i
If Not DelRange Is Nothing Then
DelRange.EntireRow.Delete
End If
End Sub

[Nova]

Wow!

It works great!!!!!!

Thank you,
Thank you,
Thank you!

[Jacob Hilderbrand]

You're Welcome

Take Care