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

kfilippo

New Member
Joined
Jan 9, 2018
Messages
11
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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
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
 
Upvote 0
Well since I was developing at the same time I'll go ahead and publish my code as well

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top