Solved

VBA Modification

Posted on 2014-07-20
7
248 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
[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: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 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
SuperAntiSpyware Licenses Discounted by 25% !

Exclusive offer to Experts Exchange Members!
Buy SuperAntiSpyware License(s) from us and save 25% on the regular purchase price.
- Includes Full SuperAntiSpyware Vendor Support Entitlements
- Your Subscription does not begin until you activate your license
- Buy for your friends

 
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 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:Naresh Patel
ID: 40208293
Awesome Thanks
0

Featured Post

SendBlaster Pro 4 - Bulk Email Sending Software

SendBlaster 4 Pro - Best Bulk Emailing Sending Software
Automatic Subscribe / Unsubscribe Processing
Great for Newsletters & Mass Mailings
Optional HTML & Text Composition
Integration with Google Features
Built in Spam Score Checking
Free Professional Templates - Feature Packed!

Question has a verified solution.

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

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
My attempt to use PowerShell and other great resources found online to simplify the deployment of Office 365 ProPlus client components to any workstation that needs it, regardless of existing Office components that may be needing attention.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
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…

751 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