Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

VBA Modification

Posted on 2014-07-20
7
Medium Priority
?
258 Views
Last Modified: 2014-07-20
Hi Experts,

Need a Help to modify existing code which is attached in WB EE Demo.xlsm
Code Post data from sheet Data To sheet Recorder on condition match.
i just want to code modify in such a way that it post data in same sheet from row number 1701.

See attached

Thanks
EE-Demo.xlsm
0
Comment
Question by:Naresh Patel
  • 4
  • 3
7 Comments
 
LVL 28

Expert Comment

by:MacroShadow
ID: 40207192
Check attached.
EE-Demo.xlsm
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 40207214
Error
Assume (there is no Recorder sheet) or just delete sheet Recorder in what i had attached .i need the existing code which copy  data from sheet data and past  To sheet recorder to be modified to copy data from sheet data and past to  same sheet data from row 1701.

Thanks
0
 
LVL 28

Accepted Solution

by:
MacroShadow earned 2000 total points
ID: 40207235
Try this:
Option Explicit
Sub Copy_Trigger_Data()
    Dim rng As Range, c As Range
    Dim intLR As Long, r As Long
    Dim dblLTP As String
    Dim dblCR1 As String
    Dim dblCR2 As String
    Dim dblCircuit As String
    Dim dtStamp As Date
    Dim tiStamp As Date
    Dim strTicker As String, strName As String, strCode As String, strSegment As String
    
    Application.ScreenUpdating = False
        
    'Start on main worksheet and select all cells in column L
    Sheets("Data").Select
    intLR = Range("B" & Cells.Rows.Count).End(xlUp).Row 'assuming that data will always exist here
    Range("L2:L1699").Select
    Set rng = Selection
    For Each c In rng
        If c.Value <> "" Then 'trigger
            'assign key values
            dtStamp = Now()
            tiStamp = Now()
            dblCR1 = c.Offset(0, -2).Value
            dblCR2 = c.Offset(0, -1).Value
            dblCircuit = c.Offset(0, 15).Value
            strTicker = c.Offset(0, -11).Value
            strName = c.Offset(0, -10).Value
            strCode = c.Offset(0, -9).Value
            strSegment = c.Offset(0, -8).Value
            dblLTP = c.Offset(0, -7).Value
            
            Range("A1700").Offset(1, 0).Select
            'insert values
            ActiveCell.Value = Format(dtStamp, "d/mmm/yy")
            ActiveCell.Offset(0, 1).Value = Format(tiStamp, "hh:mm")
            ActiveCell.Offset(0, 2).Value = Format(dblLTP, "0.00")
            ActiveCell.Offset(0, 4).Value = Format(dblCR1, "Percent")
            ActiveCell.Offset(0, 5).Value = Format(dblCR2, "Percent")
            ActiveCell.Offset(0, 6).Value = Format(dblCircuit, "0.00")
            ActiveCell.Offset(0, 8).Value = strTicker
            ActiveCell.Offset(0, 9).Value = strName
            ActiveCell.Offset(0, 10).Value = strCode
            ActiveCell.Offset(0, 11).Value = strSegment
            
            'InsertingFormula
            r = ActiveCell.Row
            Range("O" & r).Formula = "=IF($I" & r & "<>"""",VLOOKUP($I" & r & ",Data!$A:$AF,MATCH(Recorder!O$1,Data!$A$1:$AF$1,0),FALSE),"""")"
            Range("D" & r).Formula = "=IF(C" & r & "<>"""",(O" & r & "/C" & r & ")-100%,"""")"
            Range("O" & r).Copy
            Range("O" & r & ":AO" & r).PasteSpecial
            Application.CutCopyMode = False
            Range("A" & r + 1).Select

End If
    Next c
    
    FormatSheet 'Here we will call the format sheet sub which
                'will adjust the number formatting of the cells
    Application.ScreenUpdating = True
    Range("A1").Select
    
End Sub

Private Sub FormatSheet()
    Dim lastrow As Integer
    lastrow = Range("A1048576").End(xlUp).Row
    Range("D3:D" & lastrow).NumberFormat = "0.00%"
    Range("O3:O" & lastrow).NumberFormat = "0.00"
    Range("Q3:Q" & lastrow).NumberFormat = "0.00"
    Range("R3:R" & lastrow).NumberFormat = "0.00%"
    Range("S3:S" & lastrow).NumberFormat = "0.00"
    Range("T3:U" & lastrow).NumberFormat = "0%"
    Range("W3:AG" & lastrow).NumberFormat = "0.00"
    Range("AJ3:AO" & lastrow).NumberFormat = "0.00"
End Sub

Open in new window

0
Technology Partners: 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!

 
LVL 8

Author Comment

by:Naresh Patel
ID: 40208203
Mr.MacroShadow,

I had just change some lines to over come reference error with help of previous code in your mention code ....seems ok but one thing I found that - in previous if I run code its add data to every next row available from A1700, but in your code it over past on existent data as well as  one row data only in row number 1701. I guess need to modify this line ...Mod

Thanks
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 40208205
here is the full code
Option Explicit
Sub Copy_Trigger_Data()
    Dim rng As Range, c As Object
    Dim intLR As Long, r As Integer
    Dim dblLTP As Double
    Dim dblCR1 As Double
    Dim dblCR2 As Double
    Dim dblCircuit As Double
    Dim dtStamp As Date
    Dim tiStamp As Date
    Dim strTicker As String, strName As String, strCode As String, strSegment As String
    
    Application.ScreenUpdating = False
        
    'Start on main worksheet and select all cells in column L
    Sheets("Data").Select
    intLR = Range("B" & Cells.Rows.Count).End(xlUp).Row 'assuming that data will always exist here
    Range("L2:L1699").Select
    Set rng = Selection
    For Each c In rng
        If c.Value <> "" Then 'trigger
            'assign key values
            dtStamp = Now()
            tiStamp = Now()
            dblCR1 = c.Offset(0, -2).Value
            dblCR2 = c.Offset(0, -1).Value
            dblCircuit = c.Offset(0, 15).Value
            strTicker = c.Offset(0, -11).Value
            strName = c.Offset(0, -10).Value
            strCode = c.Offset(0, -9).Value
            strSegment = c.Offset(0, -8).Value
            dblLTP = c.Offset(0, -7).Value
            
            Range("A1700").Offset(1, 0).Select
            'insert values
            ActiveCell.Value = Format(dtStamp, "d/mmm/yy")
            ActiveCell.Offset(0, 1).Value = Format(tiStamp, "hh:mm")
            ActiveCell.Offset(0, 2).Value = Format(dblLTP, "0.00")
            ActiveCell.Offset(0, 4).Value = Format(dblCR1, "Percent")
            ActiveCell.Offset(0, 5).Value = Format(dblCR2, "Percent")
            ActiveCell.Offset(0, 6).Value = Format(dblCircuit, "0.00")
            ActiveCell.Offset(0, 8).Value = strTicker
            ActiveCell.Offset(0, 9).Value = strName
            ActiveCell.Offset(0, 10).Value = strCode
            ActiveCell.Offset(0, 11).Value = strSegment
            
            'InsertingFormula
            r = ActiveCell.Row
            Range("O" & r).Formula = "=IF($I" & r & "<>"""",VLOOKUP($I" & r & ",$A:$AF,MATCH(O$1700,$A$1:$AF$1,0),FALSE),"""")"
            Range("D" & r).Formula = "=IF(C" & r & "<>"""",(O" & r & "/C" & r & ")-100%,"""")"
            Range("O" & r).Copy
            Range("O" & r & ":AO" & r).PasteSpecial
            Application.CutCopyMode = False
            Range("A" & r + 1).Select

End If
    Next c
    
    FormatSheet 'Here we will call the format sheet sub which
                'will adjust the number formatting of the cells
    Application.ScreenUpdating = True
    Range("A1").Select
    
End Sub

Private Sub FormatSheet()
    Dim lastrow As Integer
    lastrow = Range("A1048576").End(xlUp).Row
    Range("D1701:D" & lastrow).NumberFormat = "0.00%"
    Range("O1701:O" & lastrow).NumberFormat = "0.00"
    Range("Q1701:Q" & lastrow).NumberFormat = "0.00"
    Range("R1701:R" & lastrow).NumberFormat = "0.00%"
    Range("S1701:S" & lastrow).NumberFormat = "0.00"
    Range("T1701:U" & lastrow).NumberFormat = "0%"
    Range("W1701:AG" & lastrow).NumberFormat = "0.00"
    Range("AJ1701:AO" & lastrow).NumberFormat = "0.00"
End Sub

Open in new window


Thanks
0
 
LVL 28

Assisted Solution

by:MacroShadow
MacroShadow earned 2000 total points
ID: 40208266
Change that line to:
Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Offset(1, 0).Select

Open in new window

0
 
LVL 8

Author Closing Comment

by:Naresh Patel
ID: 40208293
Awesome Thanks
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
With its various features, Office 365 can not only help you with your day-to-day business tasks, it can also do wonders for your marketing campaign.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

772 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