Results 1 to 7 of 7

Thread: Extracting data from a spreadsheet and putting it in a form

  1. #1

    Extracting data from a spreadsheet and putting it in a form



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hello I知 Bill
    I知 trying to write a VBA code to transfer data from a spread sheet to a form by using a if function. I want it to move the data when I post the date in the form A7. I have a spread sheet with 500 rows and 13 columns. I want to move curtain data into the form. And there are some blanks in the spread sheet. This will give you a idea what I知 trying to do.
    If cost A6:A500 has the date that enter in the form, then If C6:500 has a code of 50040 it should copy over B E F G K in form .B copied into Form A15:A26, E copied into Form E15:E26, F copied into the formF15:F26 G copied into the formH15:H26, K copied into the formI15:I26 and have it loop until it get a empty cell in the form or fill up row 26.
    If cost A6:A500 has the date that enter in the form, then If C6:500 has a code of 50000 it should copy over B D E F G K in form .B copied into Form D2840, D copied into Form B28:B40, E copied into Form G28:G40, F copied into the form H28:H40 G copied into the I28:I40, K copied into the form J28:J40 and have it loop until it get a empty cell in the form or fill up row 40.
    Thank for your help on this
    Bill

  2. #2
    Acolyte gsnidow's Avatar
    Join Date
    Aug 2011
    Location
    Virginia
    Posts
    38
    Articles
    0
    Bill, when you say "form", are you talking about a user form, like you would add via the vba project, and call with "userform1.show"? Or are you talking about worksheets in the same (or other, for that matter) workbook, that have been formatted to restrict data entry to what you want the user to do?

    Greg

  3. #3
    Quote Originally Posted by gsnidow View Post
    Bill, when you say "form", are you talking about a user form, like you would add via the vba project, and call with "userform1.show"? Or are you talking about worksheets in the same (or other, for that matter) workbook, that have been formatted to restrict data entry to what you want the user to do?

    Greg
    The user form is just a another sheet like the spreadsheet in excel

  4. #4
    It just another worksheet in the same workbook

  5. #5
    Acolyte gsnidow's Avatar
    Join Date
    Aug 2011
    Location
    Virginia
    Posts
    38
    Articles
    0
    Why don't you attach a copy of your workbook with some sample data populated, and tell us specifically what you want to happen and why. That would give us a place to start. Your initial description is somewhat hard to follow, but sounds basically easy enough. Remember, we can't see what you see.

    Greg

  6. #6
    I would like all the cell on the Dwr worksheet with whit background and black number or letters
    Attached Files Attached Files

  7. #7
    Acolyte gsnidow's Avatar
    Join Date
    Aug 2011
    Location
    Virginia
    Posts
    38
    Articles
    0
    Bill, put this code in a worksheet change event in sheet "DWR". A couple of things to note are in the comments of the code, so I suggest you read them. There may be a more elegant solution, as I really have not learned anything new in VBA since Excel 2003, but this should get you in the ball park.

    Greg

    Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    '****
    '   Caveats:
    '       1) assumes the item rows 15:26 and 28:40 on sheet "DWR" will be blank.
    '           If not, the data will be overwritten.
    '       2) code does not do any formatting, so you may want to add it.
    '       3) anything else is also possible
    
        Dim WSFrom As Worksheet
        Dim WSTo As Worksheet
        Dim dtTarget As Date
        Dim FromRange As Range
        Dim i As Long, j As Long
        Dim LastRow As Long
        Dim c As Variant
        Dim RowCount As Long
        Dim arFrom()
        
        If Target.Address <> "$A$7" Then
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        Set WSFrom = ActiveWorkbook.Sheets("Cost")
        Set WSTo = ActiveWorkbook.Sheets("DWR")
        
        dtTarget = WSTo.Cells(7, 1).Value
        RowCount = 0
        
        ' Here we are getting the range of the target date in worksheet "Cost".
        ' If it is not found, we will exit.
        With WSFrom
            LastRow = .Cells(6, 1).End(xlDown).Row
            For i = 6 To LastRow Step 1
                If .Cells(i, 1).Value = dtTarget Then
                    ' Then i is the row of the first instance of our target date.
                    Exit For
                End If
            Next i
            
            ' If i >= the value of LastRow, then we know we have searched
            ' the entire range, and did not find our target date, so exit.
            If i > LastRow Then
                MsgBox ("Target date not found")
                Exit Sub
            End If
            
            For j = i To LastRow Step 1
                If .Cells(j, 1).Value <> dtTarget Then
                    ' Then we know we have encountered the first instance of
                    ' a date that is not our target.
                    j = j - 1
                    Set FromRange = .Range(.Cells(i, 1), .Cells(j, 1))
                    Exit For
                End If
            Next j
        End With
        
        ' Look for code 50040 first, and gather the values if any
        For Each c In FromRange
            If c.Offset(0, 2).Value = 50040 Then
                ReDim Preserve arFrom(1 To 5, 1 To RowCount + 1)
                arFrom(1, RowCount + 1) = c.Offset(0, 1).Value
                arFrom(2, RowCount + 1) = c.Offset(0, 4).Value
                arFrom(3, RowCount + 1) = c.Offset(0, 5).Value
                arFrom(4, RowCount + 1) = c.Offset(0, 6).Value
                arFrom(5, RowCount + 1) = c.Offset(0, 10).Value
                RowCount = RowCount + 1
            End If
        Next c
        
        ' Populate the values in the form.  You may have to do some formatting
        ' of the target cells in your form here, as the code as it is now does
        ' not do any formatting.
        
    '**** Notice for array columns 4 and 5, we are shifting the column of the target
        ' cell one to the right.  I don't know if it is my Excel or not, but every time
        ' I ran it, the down time was populated in the end time field.  It may have
        ' something to do with the time fields, but you may have to tweak this.
        With WSTo
            For i = 1 To UBound(arFrom) Step 1
                If 15 + i - 1 <= 26 Then
                    On Error Resume Next
                    .Cells(15 + i - 1, 1).Value = arFrom(1, i)
                    .Cells(15 + i - 1, 5).Value = arFrom(2, i)
                    .Cells(15 + i - 1, 6).Value = arFrom(3, i)
                    .Cells(15 + i - 1, 8).Value = arFrom(4, i) '**** you may need to change 8 to 7 here
                    .Cells(15 + i - 1, 9).Value = arFrom(5, i) '**** you may need to change 9 to 8 here
                Else
                    Exit For
                End If
            Next i
        End With
        
        ' Reset the rowcount, and get the values for code 50000
        ' The rest is the same.
        RowCount = 0
        ReDim arFrom(1 To 6, 1 To 1)
        For Each c In FromRange
            If c.Offset(0, 2).Value = 50000 Then
                ReDim Preserve arFrom(1 To 6, 1 To RowCount + 1)
                arFrom(1, RowCount + 1) = c.Offset(0, 3).Value
                arFrom(2, RowCount + 1) = c.Offset(0, 1).Value
                arFrom(3, RowCount + 1) = c.Offset(0, 4).Value
                arFrom(4, RowCount + 1) = c.Offset(0, 5).Value
                arFrom(5, RowCount + 1) = c.Offset(0, 6).Value
                arFrom(6, RowCount + 1) = c.Offset(0, 10).Value
                RowCount = RowCount + 1
            End If
        Next c
        
        With WSTo
            For i = 1 To UBound(arFrom) Step 1
                If 28 + i - 1 <= 40 Then
                    On Error Resume Next
                    .Cells(28 + i - 1, 1).Value = arFrom(1, i)
                    .Cells(28 + i - 1, 4).Value = arFrom(2, i)
                    .Cells(28 + i - 1, 7).Value = arFrom(3, i)
                    .Cells(28 + i - 1, 8).Value = arFrom(4, i)
                    .Cells(28 + i - 1, 9).Value = arFrom(5, i)
                    .Cells(28 + i - 1, 10).Value = arFrom(6, i)
                Else
                    Exit For
                End If
            Next i
        End With
        
        Application.ScreenUpdating = True
            
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •