Sub fixdatabaseSAS()
Application.ScreenUpdating = False
MoveEmSAS
MoveEm1SAS
cleanupSAS
Application.ScreenUpdating = True
End Sub
Private Sub MoveEmSAS()
Dim i As Long
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Val(Left(Cells(i, 2), 1)) < 1 Then
Cells(i, 2).Cut
Cells(i - 1, 3).Insert Shift:=xlToRight
End If
Next i
End Sub
Private Sub MoveEm1SAS()
Dim i As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 2) = "" Then
Cells(i, 1).Cut
Cells(i - 1, 2).Insert Shift:=xlToRight
End If
Next i
End Sub
Private Sub cleanupSAS()
Dim lr As Long
Dim lc As Double
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column
With Cells(1, 1).Resize(lr, lc)
..WrapText = False
..Rows.AutoFit
..Columns.AutoFit
..SpecialCells(xlCellTypeBlanks).Delete
..Interior.ColorIndex = xlNone
End With
End Sub
--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Don Guillett" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Seems like a chore to loop thru 33000 cells when FIND will find it
> quicker...
> If desired, send your file to my address below. I will only look if:
> 1. You send a copy of this message on an inserted sheet
> 2. You give me the newsgroup and the subject line
> 3. You send a clear explanation of what you want
> 4. You send before/after examples and expected results.
>
>
> --
> Don Guillett
> Microsoft MVP Excel
> SalesAid Software
> (E-Mail Removed)
> "Ann" <(E-Mail Removed)> wrote in message
> news:C3E49B64-B563-4013-8462-(E-Mail Removed)...
>> Hi,
>>
>> I have the following code that someone on this site wrote for me and I
>> love
>> it and use it all the time. My problem is that this goes down the rows
>> looking for the city, state and zip code , finds it, selects the row, and
>> move backwards to select the rows above that I need. Then they are
>> copied,
>> pasted (transposed) in the next columns over. I still need it to find
>> the
>> city, state and zip code but select the cell they are in and then move to
>> the
>> left by one cell, copy those two cells, and now when it pastes in the
>> adjacent columns I no longer need it to be transposed. I hope that makes
>> sense and I hope someone can help me.
>>
>> Dim iRow As Long
>>
>> For iRow = 1 To 32999
>>
>> Range("A1").Select
>>
>> Range("A" & iRow).Select
>> If Selection Like "*,?? ?????" Then
>>
>> Range("A" & iRow & ":A" & iRow - 2).Select
>> Range("A" & iRow & ":A" & iRow - 2).Copy
>> Range("B" & iRow - 1 & ":B" & iRow - 1).PasteSpecial , , , True
>>
>> End If
>> Next
>>
>> Dim iRow As Long
>>
>> For iRow = 1 To 160
>>
>> Range("A1").Select
>>
>> If iRow = 1 Then
>> Selection.EntireRow.Insert
>> End If
>>
>> Range("A" & iRow).Select
>> If Selection Like "*,?? ?????" Then
>>
>> Range("A" & iRow & ":A" & iRow - 2).Select
>> Range("A" & iRow & ":A" & iRow - 2).Copy
>> Range("B" & iRow - 1 & ":B" & iRow - 1).PasteSpecial , , , True
>>
>> End If
>> Next
>
Similar Threads
