Moving Numbers ONLY

**Hyflex** · 10-29-2012, 04:23 PM

Hey Guys,

Here is a copy of the macro I've been trying to get working, could someone help make it better and fix it for the bug what I've come across

Basically, I'm trying to move any cell in the ADM:ADV range what has a number in it across to columns at the left (M to V) for example)

Thanks in advance
- Hyflex

Sub testmacro()

    'Switch Sheets'
    Sheets("MAINSHEET").Activate

    'Set Last Row'
    LastRow = Range("A104856").End(xlUp).Row
    
    Dim cl As Variant
    For Each cl In Sheets("MAINSHEET").Range("ADM19:ADM" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADN19:ADN" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADO19:ADO" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADP19:ADP" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADQ19:ADQ" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADR19:ADR" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADS19:ADS" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADT19:ADT" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADV19:ADV" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl
    For Each cl In Sheets("MAINSHEET").Range("ADW19:ADW" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsNumeric(cl.Value) Then
            cl.Offset(0, -786).Value = cl.Value
        End If
    Next cl

End Sub

**zbor** · 10-29-2012, 04:37 PM

Will LARGE function help withou need of the loop if your new values can be in descending order? Or SMALL for ascending

**AB33** · 10-29-2012, 04:44 PM

No wonder why you getting errors!
I have to admit this is the first time in my life to see Range("ADW19:ADW")
I have never been to this part of excel. My limit has been two digits range
The code works, but not if a cell is empty. I kept getting errors until I put some dummy data ine each cell. I think you will have a fun of using this code.
You could also change the lastrow line in to

LastRow = Sheets("MAINSHEET").UsedRange.Rows.Count

**Hyflex** · 10-29-2012, 05:01 PM

Originally Posted by zbor

Will LARGE function help withou need of the loop if your new values can be in descending order? Or SMALL for ascending

Hi Zbor,

I'm slightly confused by what you said :S

Originally Posted by AB33

No wonder why you getting errors!
I have to admit this is the first time in my life to see Range("ADW19:ADW")
I have never been to this part of excel. My limit has been two digits range
The code works, but not if a cell is empty. I kept getting errors until I put some dummy data ine each cell. I think you will have a fun of using this code.
You could also change the lastrow line in to

LastRow = Sheets("MAINSHEET").UsedRange.Rows.Count

The last row always has to be done by column A because of how my document is designed, I cant get around the issue where if the range is empty it throws up an error.

**tigeravatar** · 10-29-2012, 04:55 PM

Hyflex,

It's difficult to test this without a sample workbook, but here's a revamped version of that code you provided, which should work quicker and be error free:

Sub tgr()
    
    Dim rngCheck As Range
    Dim CheckArea As Range
    Dim CheckCell As Range
    Dim arrNums() As Variant
    Dim lLastRow As Long
    
    With Sheets("MAINSHEET")
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lLastRow < 19 Then Exit Sub  'No data
        
        Set rngCheck = .Range("ADM19:ADT" & lLastRow & ",ADV19:ADW" & lLastRow)
        
        On Error Resume Next
        For Each CheckArea In rngCheck.Areas
            ReDim arrNums(1 To CheckArea.Rows.Count, 1 To CheckArea.Columns.Count)
            For Each CheckCell In CheckArea.SpecialCells(xlCellTypeConstants, xlNumbers).Cells
                arrNums(CheckCell.Row - CheckArea.Row + 1, CheckCell.Column - CheckArea.Column + 1) = CDbl(CheckCell.Value2)
            Next CheckCell
            CheckArea.Offset(0, -786).Value = arrNums
            Erase arrNums
        Next CheckArea
        On Error GoTo 0
    End With
    
    Set rngCheck = Nothing
    Set CheckArea = Nothing
    Set CheckCell = Nothing
    
End Sub

**Hyflex** · 10-29-2012, 05:47 PM

Hey Tigeravatar,

Thanks for your reply, I'm really confused as to why yours has two ranges in RngCheck

**zbor** · 10-29-2012, 05:08 PM

Well just make loop for i from 1 to COUNT values in A column with application.worksheetfunction.large("A1:A60000", i)

**AB33** · 10-29-2012, 05:10 PM

John,
I have put some dummy data in ADM19:ADW19(Was really good fun to go all the way to these columns) and the code works

**tigeravatar** · 10-29-2012, 05:54 PM

Hyflex,

It is because the code you posted in your original post skips column ADU. So you have AD.. M,N,O,P,Q,R,S,T and then V,W. Between T and V should be U, but your code doesn't have that, so the code I provided mirrors that, hence the two ranges "ADM:ADT,ADV:ADW"

**Hyflex** · 10-29-2012, 06:08 PM

Hey tigeravatar,

Ahh my bad, I clearly don't know my alphabet. It was 10 columns from ADM, so AD.. M, N, O, P, Q, R, S, T, U, V

I just tried to modify your macro but I can't get it to work now.

**tigeravatar** · 10-29-2012, 06:11 PM

Because it is now a continuous block of cells, the macro can be somewhat simplified:

Sub tgr()
    
    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim arrNums() As Variant
    Dim lLastRow As Long
    
    With Sheets("MAINSHEET")
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lLastRow < 19 Then Exit Sub  'No data
        
        Set rngCheck = .Range("ADM19:ADV" & lLastRow)
        
        On Error Resume Next
        ReDim arrNums(1 To rngCheck.Rows.Count, 1 To rngCheck.Columns.Count)
        For Each CheckCell In rngCheck.SpecialCells(xlCellTypeConstants, xlNumbers).Cells
            arrNums(CheckCell.Row - rngCheck.Row + 1, CheckCell.Column - rngCheck.Column + 1) = CDbl(CheckCell.Value2)
        Next CheckCell
        rngCheck.Offset(0, -786).Value = arrNums
        Erase arrNums
        On Error GoTo 0
    End With
    
    Set rngCheck = Nothing
    Set CheckCell = Nothing
    
End Sub

**Hyflex** · 10-30-2012, 04:03 PM

Amazing, you never fail to make perfect macros.

One last change is I need to make all of the numbers turned into 0 decimal places. I tried the following:

Range("G19:P" & LastRow).SpecialCells(xlCellTypeConstants, xlNumbers).NumberFormat = "0"

but anything what isn't a number is removed for some reason

**Hyflex** · 11-05-2012, 08:57 AM

Still been unable to fix this last small bug, anyone have any ideas?

**tigeravatar** · 11-05-2012, 11:43 AM

Try:

.NumberFormat = "0;-0;0;@"

**Hyflex** · 11-05-2012, 01:17 PM

Thanks tigeravatar, it seems like the issue is in the first part of the macro.

If over at: ADM19:ADV & LR is a number it should move it to the left but if it's blank it shouldn't do anything.

It wipes cells what have text in over at the left otherwise.

**tigeravatar** · 11-05-2012, 02:00 PM

So the cells at the left are not already blank, but have existing text in them, and the macro is overriding them to be blank cells when it brings the numbers over from the ADM:ADV range?

If that is the case, give this version a try:

Sub tgr()
    
    Dim rngCheck As Range
    Dim CheckCell As Range
    Dim arrNums() As Variant
    Dim lLastRow As Long
    
    With Sheets("MAINSHEET")
        lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lLastRow < 19 Then Exit Sub  'No data
        
        Set rngCheck = .Range("ADM19:ADV" & lLastRow)
        arrNums = rngCheck.Offset(0, -786).Value
        
        On Error Resume Next
        For Each CheckCell In rngCheck.SpecialCells(xlCellTypeConstants, xlNumbers).Cells
            If IsNumeric(CheckCell.Value2) Then arrNums(CheckCell.Row - rngCheck.Row + 1, CheckCell.Column - rngCheck.Column + 1) = CDbl(CheckCell.Value2)
        Next CheckCell
        rngCheck.Offset(0, -786).Value = arrNums
        Erase arrNums
        On Error GoTo 0
    End With
    
    Set rngCheck = Nothing
    Set CheckCell = Nothing
    
End Sub

Moving Numbers ONLY

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Re: Moving Numbers ONLY

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions