[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 241
  • Last Modified:

VBA Code

Hi,

Im looking for a piece of code that will do two things on the attached ss.

(1) Search for all cells containing "Net Difference" and move it one cell to the left
(2) Find the currency three cells above and copy it into where "Net Difference was".

Thanks
Seamus
Example.xls
0
Seamus2626
Asked:
Seamus2626
  • 8
  • 5
  • 4
  • +1
3 Solutions
 
sdwalkerCommented:
This will do it.
Sub Test()

lastRow = Sheets("Sheet0").Range("C20000").End(xlUp).Row

For i = 1 To lastRow
  If InStr(1, UCase(Sheets("Sheet0").Range("C" & i).Value), "NET DIFFERENCE") Then
    Sheets("Sheet0").Range("C" & i).Offset(0, -1).Value = Sheets("Sheet0").Range("C" & i).Value
    Sheets("Sheet0").Range("C" & i).Value = Sheets("Sheet0").Range("C" & i).Offset(-3, 0).Value
  End If
Next i


End Sub

Open in new window

0
 
nutschCommented:
Hi Seamus,

This code should do it.

Thomas
Sub asdgasdga()
Dim cl As Range
application.screenupdating=false
Range("a1:C" & Cells(Rows.Count, "C").End(xlUp).Row).AutoFilter field:=3, Criteria1:="NET DIFFERENCE"

With Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
    .Offset(1).SpecialCells(xlCellTypeVisible).Offset(, -1) = "NET DIFFERENCE"
    .SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=R[-3]C"
        
    For Each cl In .Offset(1).SpecialCells(xlCellTypeVisible).Cells
        cl.Value = cl.Offset(-3).Value
    Next
End With

ActiveSheet.AutoFilterMode = False
application.screenupdating=true
End Sub

Open in new window

0
 
SiddharthRoutCommented:
Not for Points But since I was almost done, I will paste the code. Also I am using a different approach than sdwalker. I am using .Find rather than looping rows as .Find is much faster

Sub Sample()
    Dim oRange As Range, aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim ExitLoop As Boolean
    Dim SearchString As String
    On Error GoTo Err
    
    Set ws = Worksheets("Sheet0")
    Set oRange = ws.Columns(3)

    SearchString = "NET DIFFERENCE"
    
    Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
    
    If Not aCell Is Nothing Then
        Set bCell = aCell
        aCell.Offset(0, -1).Value = aCell.Value
        aCell.Value = aCell.Offset(-3, 0).Value
        Do While ExitLoop = False
            Set aCell = oRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                aCell.Offset(0, -1).Value = aCell.Value
                aCell.Value = aCell.Offset(-3, 0).Value
            Else
                ExitLoop = True
            End If
        Loop
    Else
        MsgBox SearchString & " not Found"
    End If
    Exit Sub
Err:
    MsgBox Err.Description
End Sub

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
nutschCommented:
@sdwalker

Sorry, didn't see your post. Do you want my input on your code?

T
0
 
nutschCommented:
@Sid, autofilter is even faster!
0
 
SiddharthRoutCommented:
nutsch's code is much faster than mine as it uses autofilter. Nice one nutsch!!! Didn't think of that.

Sid
0
 
SiddharthRoutCommented:
Sorry didn't see your post... :)

Sid
0
 
Seamus2626Author Commented:
Thanks guys, all good!!


Cheers
Seamus
0
 
sdwalkerCommented:
Thomas ... I'll always take your input on my code.  I'm always looking to improve.
0
 
nutschCommented:
@sdwalker
My comments in your code, knowing that I'm sure you took shortcuts to get a fast answer in.

Thomas
Sub Test()
'better to define all variables first
Dim i As Long, lastRow As Long

'lastRow = Sheets("Sheet0").Range("C20000").End(xlUp).Row
'handle the whole sheet when you run the lastRow, using rows.count
lastRow = Sheets("Sheet0").Cells(Rows.Count, "C").End(xlUp).Row

'most loops can be replaced by autofilter with specialcells(xlcelltypevisible)
'or a .find structure (if there are fewer lines)

For i = 1 To lastRow
'you can use With / End With to simplify reading
    With Sheets("Sheet0").Range("C" & i)
        If InStr(1, UCase(.Value), "NET DIFFERENCE") Then
          .Offset(0, -1).Value = .Value
          .Value = .Offset(-3, 0).Value
        End If
    End With
Next i

End Sub

Open in new window

0
 
sdwalkerCommented:
Thanks for the help, Thomas.  You are correct that I took a couple of shortcuts, but I didn't know about the faster processing with Special Cells.

You would both probably be interested in my little test.   When I ran all of our code on the test data supplied, mine and Siddharth's were slightly faster (.016 sec vs .047 sec).  

nutsch       0.047
nutsch       0.047
nutsch       0.047
sdwalker       0.016
sdwalker       0.016
sdwalker       0.016
siddharth       0.016
siddharth       0.016
siddharth       0.016

When I multiplied the recordset about 30 times (going to row 6600 instead of row 183), nutsch's was faster than mine or Sid's (I did add the screen updating to mine, as I usually do that for large datasets).

nutsch       0.109
nutsch       0.141
nutsch       0.109
nutsch       0.125
nutsch       0.109
sdwalker       0.281
sdwalker       0.281
sdwalker       0.266
siddharth       0.297
siddharth       0.266
siddharth       0.281
siddharth       0.281

So in this case, I'm not finding the .Find to be much faster.

Thoughts?
0
 
sdwalkerCommented:
Correction, I just added screenupdating to sid's code and it now comes in second for the longer dataset.

siddharth       0.172
siddharth       0.172
siddharth       0.172
siddharth       0.188

Interesting ...
0
 
nutschCommented:
I guess the .Find is still a loop in a way
On my code, removing the cl loop might speed it up for high number of rows, but I'm not sure.

T
Sub asdgasdga()
Dim cl As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("a1:C" & Cells(Rows.Count, "C").End(xlUp).Row).AutoFilter field:=3, Criteria1:="NET DIFFERENCE"

With Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
    .Offset(1).SpecialCells(xlCellTypeVisible).Offset(, -1) = "NET DIFFERENCE"
    .SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=R[-3]C"
    
    .Offset(1).SpecialCells(xlCellTypeVisible).FormulaR1C1 = "=R[-3]C"
    
    ActiveSheet.AutoFilterMode = False
    
    Columns(3).Copy
    Columns(3).PasteSpecial Paste:=xlPasteValues
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
SiddharthRoutCommented:
sdwalker: For relatively small number of rows say for example 10 Rows, looping is fine and even I would prefer that over .Find and Autofilter as that is too much of code to write just for 10 rows.

However as the rows go up considerably say 6000 or let's say 20000 then yes, I would give the following preference to codes.

1) Autofilter
2) .Find
3) Looping

Let me do some test results.

Sid

0
 
SiddharthRoutCommented:
Ok here it is. I have attached a sample file so that you may want to test it your self.

I just added sheet names in Thoma's code and removed Screenupdating from his code.

Sid
Test.xls
Untitled.jpg
0
 
SiddharthRoutCommented:
Sorry wrong picture...

Sid
0
 
SiddharthRoutCommented:
Anyways run the test and see what do you get.

Sid
0
 
SiddharthRoutCommented:
Also if you want, you can replace tickcount with Now.

Sid
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 8
  • 5
  • 4
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now