Solved

VBA Modification

Posted on 2014-07-20
7
244 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
Optimizing Cloud Backup for Low Bandwidth

With cloud storage prices going down a growing number of SMBs start to use it for backup storage. Unfortunately, business data volume rarely fits the average Internet speed. This article provides an overview of main Internet speed challenges and reveals backup best practices.

 
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

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
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 demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

773 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