Solved

Excel VBA script

Posted on 2011-03-16
8
259 Views
Last Modified: 2012-05-11
I need some help writing a visual basic script to run in Excel on output from a database program. The logic would be as follows.
find "D" in column A and set x to the row number
if C(x+1) is not null then copy Ax and Bx to A(x+1) and B(x+1) respectively
repeat

Essentially it just needs to copy the cells from column A and B down one row if there is a value in column C on that next row.
I can usually cobble together vbscript ok but as I have never worked with excel VBA I am having difficulty and I can't seem to find examples to work from with this so any help would be appreciated.
0
Comment
Question by:zeetec
  • 5
  • 3
8 Comments
 
LVL 22

Expert Comment

by:rspahitz
ID: 35152471
I would suggest doing this with formulas to find where the pieces are that you want.

In Columns D and E put this formula, starting with column 2:

D2:
=if(Search("D",A1)>0, if(C2<>"", A2,""), "")

E2:
=if(D2<>"", B2, "")

Now you should get values in columns D and E only in the places where you want to insert into columns A and B.

Turn on filters and filter D and E so they only show non-blanks.
Copy everything from D and E and paste into A and B.

(I haven't tested it yet, so make a backup first to ensure you can restore A and B as needed.)
0
 

Author Comment

by:zeetec
ID: 35152918
Hi Rspahitz,

Thanks for your suggestion but I need to run a recursive script to update the data in one step. Trying to use formulas is going to be very fiddly if not impossible with the main problem being that Ax and Bx may need to be copied down anywhere from 1 to 100 or more times depending on whether there is data in column c in the row below. Unless I am missing something, your formulas are useful only if you do filter copy filter copy filter copy etc which is not an option. I hope that make sense?
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 35153540
You should be able to apply the formula as far down as needed, filter once, then copy all and paste apply the results in one shot.  However, if you plan to do this more than once, then that might be too many steps.
Let me see if I can come up with a VBA solution.
0
 

Author Comment

by:zeetec
ID: 35153569
Maybe I should give an example because I am not sure if I was clear about the problem. Here is an example of the data before and after the process.

 D1234 John Smith $123
                               $323
                               $243

 D1234 John Smith $123
 D1234 John Smith $323
 D1234 John Smith $243

Does that help make it clearer?
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 22

Expert Comment

by:rspahitz
ID: 35153633
This seems to work.  notice that this will destroy whatever is located in columns A and B, whenever it find a "D" in column A's previous row and a null in column C.
For that reason, I am putting the values into columns 4 and 5 so you can test it.  If you find it does the job as expected, change the 4 and 5 to 1 and 2.
 
Sub UpdateSomeItems()
    Dim iRow As Integer
    Dim strColumnACell As String
    Dim iTransferCount As Integer
    
    iRow = 1
    iTransferCount = 0
    Do
        strColumnACell = Cells(iRow, 1).Value
        
        If Cells(iRow, 1).Value = "" Then
            ' exit when column A has no value in it
            Exit Do
        End If
        
        If InStr(strColumnACell, "D") > 0 Then
            ' Cell in column A contains a capital D
            If Cells(iRow + 1, 3).Value <> "" Then
                ' Transfer cells in column A and B down
                iRow = iRow + 1
                ' copy from column A (1)
                Cells(iRow, 4).Value = Cells(iRow - 1, 1).Value
                ' copy from column B (2)
                Cells(iRow, 5).Value = Cells(iRow - 1, 2).Value
                iTransferCount = iTransferCount + 1
            End If
        End If
        iRow = iRow + 1
    Loop
    MsgBox "Done transferring " & iTransferCount & " item" & IIf(iTransferCount = 1, "", "s") & ".", vbOKOnly Or vbInformation
End Sub

Open in new window

0
 
LVL 22

Accepted Solution

by:
rspahitz earned 500 total points
ID: 35153667
For the example you gave, I changed the logic a bit so it checks to see if there's something in column C first, then it checks the previous row to see if it contains a "D"

Also, since I'm not sure how you can tell when the data ends (which row) I simply put 50.  You can put something sufficiently large if you like, such as 10,000, but it might take longer to run.
 
Sub UpdateSomeItems()
    Dim iRow As Integer
    Dim strColumnCCell As String
    Dim iTransferCount As Integer
    
    iRow = 2
    iTransferCount = 0
    Do
        strColumnCCell = Cells(iRow, 3).Value
        
        'If Cells(iRow, 1).Value = "" Then
        If iRow = 50 Then
            ' exit when column A has no value in it
            Exit Do
        End If
        
        If strColumnCCell <> "" Then
            ' Cell in column C contains a value
            If InStr(Cells(iRow - 1, 1).Value, "D") > 0 Then
                If Cells(iRow, 1).Value = "" Then
                ' only apply if there's not something there already
                ' D found in column A of previouis row
                ' Transfer cells in column A and B down
                ' copy from column A (1)
                Cells(iRow, 1).Value = Cells(iRow - 1, 1).Value
                ' copy from column B (2)
                Cells(iRow, 2).Value = Cells(iRow - 1, 2).Value
                iTransferCount = iTransferCount + 1
                End If
            End If
        End If
        iRow = iRow + 1
    Loop
    MsgBox "Done transferring " & iTransferCount & " item" & IIf(iTransferCount = 1, "", "s") & ".", vbOKOnly Or vbInformation
End Sub

Open in new window

0
 

Author Comment

by:zeetec
ID: 35161043
That is perfect. Thank you. The file I have at the moment is 14000 rows and it only took a few seconds to complete so no problem there. Your code will help me greatly in future when working with Excel in VB thanks.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 35161230
Glad it helped! :)
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

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
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…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

943 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

4 Experts available now in Live!

Get 1:1 Help Now