Solved

VBA Modification

Posted on 2014-07-20
7
243 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
  • 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Question to the line 4 39
Create Form using Wizard 14 31
File not loading into PowerPivot 4 9
Dynamic Filter ? 4 0
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

914 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

23 Experts available now in Live!

Get 1:1 Help Now