Solved

VBA Code

Posted on 2011-03-04
18
213 Views
Last Modified: 2012-05-11
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
Comment
Question by:Seamus2626
  • 8
  • 5
  • 4
  • +1
18 Comments
 
LVL 12

Accepted Solution

by:
sdwalker earned 166 total points
ID: 35038038
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
 
LVL 39

Assisted Solution

by:nutsch
nutsch earned 167 total points
ID: 35038098
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
 
LVL 30

Assisted Solution

by:SiddharthRout
SiddharthRout earned 167 total points
ID: 35038100
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
 
LVL 39

Expert Comment

by:nutsch
ID: 35038118
@sdwalker

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

T
0
 
LVL 39

Expert Comment

by:nutsch
ID: 35038128
@Sid, autofilter is even faster!
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038131
nutsch's code is much faster than mine as it uses autofilter. Nice one nutsch!!! Didn't think of that.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038139
Sorry didn't see your post... :)

Sid
0
 

Author Closing Comment

by:Seamus2626
ID: 35038146
Thanks guys, all good!!


Cheers
Seamus
0
 
LVL 12

Expert Comment

by:sdwalker
ID: 35038171
Thomas ... I'll always take your input on my code.  I'm always looking to improve.
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 39

Expert Comment

by:nutsch
ID: 35038214
@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
 
LVL 12

Expert Comment

by:sdwalker
ID: 35038340
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
 
LVL 12

Expert Comment

by:sdwalker
ID: 35038354
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
 
LVL 39

Expert Comment

by:nutsch
ID: 35038396
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038406
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038634
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
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038642
Sorry wrong picture...

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038656
Anyways run the test and see what do you get.

Sid
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 35038671
Also if you want, you can replace tickcount with Now.

Sid
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now