Solved

VBA Modification

Posted on 2014-07-20
7
247 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:itjockey
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 27

Expert Comment

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

Author Comment

by:itjockey
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 27

Accepted Solution

by:
MacroShadow earned 500 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
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!

 
LVL 8

Author Comment

by:itjockey
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:itjockey
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 27

Assisted Solution

by:MacroShadow
MacroShadow earned 500 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:itjockey
ID: 40208293
Awesome Thanks
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!

Question has a verified solution.

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

Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

761 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