Deleting blank cells w/o impacting other rows/columns

S

ShagNasty

I need a Macro that would find the BLANK CELLS in a column. It would delete
the blank cell plus the cells in the preceding 2 columns and shift them up
without impacting the remaining columns or rows across the spreadsheet.
The spreadsheet repeats every 3rd column with a different item and may
extend 90 columns by 1000 rows.
Example:
If C4 is blank, need to delete cells A4:C4 and SHIFT UP the remaining items
in the 3 columns for each blank cell found in column C. This routine would
need to repeat across the spreadsheet until all items are checked.
"Joel" provided me with a routine (excellent help & patience) that has
gotten me this far along under "Capturing data only when a column 'Value'
changes" dated 10/23/08..
A B C D E F
1 Item A 09/30/2008 11:55:00 ON Item B 09/30/2008 11:55:00
2 Item A 09/30/2008 11:56:00 ON Item B 09/30/2008 11:56:00 OPEN
3 Item A 09/30/2008 11:57:00 OFF Item B 09/30/2008 11:57:00 OPEN
4 Item A 09/30/2008 11:58:00 Item B 09/30/2008 11:58:00 CLOSE
5 Item A 09/30/2008 11:59:00 OFF Item B 09/30/2008 11:59:00 CLOSE
6 Item A 10/01/2008 00:00:00 OFF Item B 10/01/2008 00:00:00
7 Item A 10/01/2008 00:01:00 ON Item B 10/01/2008 00:01:00
8 Item A 10/01/2008 00:02:00 OFF Item B 10/01/2008 00:02:00 OPEN
9 Item A 10/01/2008 00:03:00 ON Item B 10/01/2008 00:03:00 OPEN
10 Item A 10/01/2008 00:04:00 Item B 10/01/2008 00:04:00 OPEN
11 Item A 10/01/2008 00:05:00 OFF Item B 10/01/2008 00:05:00 CLOSE
12 Item A 10/01/2008 00:06:00 ON Item B 10/01/2008 00:06:00 CLOSE

Thanks in advance..
Shag (excel crash dummy)
 
J

JLGWhiz

Try this on a copy of your sheet before you install it into your main
program. it is based on the layout in your posting which shows four columns.
If there is acturally only three then change:

For i = 4 To lstCl Step 4

To:

For i = 3 To lstCl Step 3


Sub delCels()
Dim lstRw As Long, lstCl As Long
lstRw = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lstCl = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 4 To lstCl Step 4
For j = lstRw To 2 Step -1
If Cells(j, i) = "" Or IsEmpty(Cells(j, i)) Then
Range(Cells(j, i - 2), Cells(j, i)).Delete
End If
Next
Next
End Sub
 
T

The Code Cage Team

Hi drop all this in a standard module, the code will look at every 3rd
column up to a maximum of all used coulmns and work up from the last
used cell when it finds a blank it will delete the cells for all 3
columns in that row then it will move 3 columns over and do the same!

Sub delete_blanks()
Dim Rng As Range, MyCell As Range
Dim i As Long, r As Long
Dim C1 As String, C2 As String
For i = 3 To ActiveSheet.UsedRange.Columns.Count Step 3
C1 = ColumnLetter(i - 0)
C2 = ColumnLetter(i - 2)
For r = Range(C1 & Rows.Count).End(xlUp).Row To 1 Step -1
If Range(C1 & r).Value = "" Then
Range(C1 & r & ":" & C2 & r).Delete shift:=xlUp
End If
Next r
Next i
End Sub
Function ColumnLetter(ColumnNumber As Integer) As String
If ColumnNumber > 26 Then

ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
Chr(((ColumnNumber - 1) Mod 26) + 65)
Else
ColumnLetter = Chr(ColumnNumber + 64)
End If
End Function


--
The Code Cage Team

Regards,
The Code Cage Team
www.thecodecage.com
 
S

ShagNasty

There are three columns -- tag, time, & value that repeat. Guess I got happy
fingers when I posted the info...

Thanks,
 
T

The Code Cage Team

Repeat on the same sheet or on other sheets, same sheet my code will d
what you want i.e every third column find blanks and remove data fo
that row for the preceeding 2 columns.

Is that not what you wanted

--
The Code Cage Tea

Regards,
The Code Cage Team
www.thecodecage.co
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top