Macro that identifies non blank values on column and create new column on another tab with no empty values

[kfilippo]

Hello,

I'm new to VBA and I would like some help.

I have a huge table and I'm interested in values on columns A, H and I. What I would like to do is to identify for each row if the cells on columns H and I are empty or not. If either cells on column H or cells on column I on a specific row are not empty, I want to get these values (along with values displayed on column A) and paste them in a table in another tab. If both cells on column H and column I on a row are empty, then I dont want to get any value of this table.


Can someone help me with this?

Thank you

 

[SteveO59L]

something along the lines of

Dim c As Range, rng
Dim lr As Long
Dim a_val As String
Dim h_val As String
Dim i_val As String

lr = Range("h" & Rows.Count).End(xlUp).Row
Set rng = Range("h1:h" & lr)
For Each c In rng
If c.Value <> "" Or c.Offset(0, 1).Value <> "" Then
a_val = c.Offset(0, -7).Value
h_val = c.Value
i_val = c.Offset(0, 1).Value
Sheets("sheet2").Activate
lr = Range("a" & Rows.Count).End(xlUp).Row + 1
Range("a" & lr) = a_val
Range("h" & lr) = h_val
Range("i" & lr) = i_val
Sheets("sheet1").Activate
End If
Next c

 

[frank_AL]

Well since I was developing at the same time I'll go ahead and publish my code as well

Option Explicit


Sub copyAHI()
Dim i As Long
Dim lastrow As Long
Dim nextrow As Long
Dim cfws As Worksheet
Dim ctws As Worksheet
Dim val As Boolean


Set cfws = Sheet1
Set ctws = Sheet2


lastrow = cfws.Cells(cfws.Rows.Count, "A").End(xlUp).Row
nextrow = ctws.Cells(ctws.Rows.Count, "A").End(xlUp).Row + 1
val = False


For i = 2 To lastrow
    If Not IsEmpty(cfws.Range("H" & i)) Then
        val = True
    ElseIf Not IsEmpty(cfws.Range("I" & i)) Then
        val = True
    End If
    If val = True Then
        ctws.Cells(nextrow, 1).Value = cfws.Cells(i, 1).Value
        ctws.Cells(nextrow, 2).Value = cfws.Cells(i, 8).Value
        ctws.Cells(nextrow, 3).Value = cfws.Cells(i, 9).Value
        nextrow = nextrow + 1
    End If
    val = False
Next i


End Sub

 

[kfilippo]

Thank you!
It worked for me