CODEWITHSUNDEEP
vbaexcel
blindman457
blindman457

Reputation: 293

excel vba placed data going into wrong cells

I have an input sheet ("by month") where the user inputs data into some cells and then sorts that data into two separate spreadsheets ("ordersbyLOGdate" and "ordersbySHIPdate") - as you can guess these spreadsheets contain the same data but sort them differently (by log date and then by ship date).

I can read and store the data fine, however when sorting the data and placing it in a spreadsheet, it doesn't end up where I want it to go, can anyone see what I'm missing here?

Sub Button1_Click()
Dim countR As Long
Dim countLoop As Long
countLoop = 1

countR = firstBlankRow(ThisWorkbook.Worksheets("by month"))
countR = countR - 1
Dim colL As String
Dim company As String
Dim orderNumb As String
Dim oDate As Date
Dim total As Double
Dim orderStatus As String
Dim shipMethod As String
Dim sDate As Date    
Dim orderStock As String    

For i = 2 To countR 'countR is the first row down with nothing in it (leng = 0) and then - 1 (to get the next row up)... that's how many rows have inputs in them that need to be stored
    ThisWorkbook.Worksheets("by month").Activate
    company = Range("A" & i).Value
    orderNumb = Val(Range("B" & i).Value)
    oDate = Range("C" & i).Value
    total = Val(Range("D" & i).Value)
    orderStatus = (Range("E" & i).Value)
    shipMethod = Range("I" & Count).Value
    sDate = Range("J" & i).Value
    orderStock = Range("K" & i).Value
    Dim LL As Long
    LL = Range("D" & Rows.Count).End(xlUp).Row + 1 + 1

    ThisWorkbook.Worksheets("ordersbyLOGdate").Activate
    Dim rowN As Integer
    rowN = 2
    Do Until Range("C" & rowN).Value >= oDate Or rowN = 10000 '10,000 stops infinite row checking
    rowN = rowN + 1
    Loop 'once loop finishes we should have found a place to insert data, insert a row and place data inside the row
    If Range("C" & rowN).Value = oDate Then
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If Range("C" & rowN).Value > oDate Then
        Debug.Print ("compare date is GREATER than oDate, - 1 from rowN and insert data there")
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If rowN = 10000 Then
        MsgBox ("ERROR")
        Exit Sub
    End If

    ThisWorkbook.Worksheets("ordersbySHIPdate").Activate
    rowN = 2
    Do Until Range("C" & rowN).Value >= sDate Or rowN = 10000
        rowN = rowN + 1
    Loop
    If Range("C" & rowN).Value = sDate Then
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If Range("C" & rowN).Value > sDate Then
        Range("A" & rowN).EntireRow.Insert
        Range("A" & rowN).Value = company
        Range("B" & rowN).Value = orderNumb
        Range("C" & rowN).Value = oDate
        Range("D" & rowN).Value = total
        Range("E" & rowN).Value = orderStatus
        Range("I" & rowN).Value = shipMethod
        Range("J" & rowN).Value = sDate
        Range("K" & rowN).Value = orderStock
    End If
    If rowN = 10000 Then
        MsgBox ("ERROR")
        Exit Sub
    End If

    Next

    ThisWorkbook.Worksheets("ordersbyLOGdate").Activate 'start sorting data into its proper place
    rowN = 2 'start at the first row of data, a heading is placed in row 1
    Dim check As Boolean
    check = True
    Dim blankRows As Integer
    blankRows = 0
    Dim startR As Long
    Dim endR As Long
    startR = 0
    endR = 0

    Do Until blankRows = 15
        If Range("J" & rowN).Value <> "" Then
            blankRows = 0
            If check = True Then
                startR = rowN
                endR = Range("D" & rowN).End(xlDown).Row
                endR = endR - 1
                Range("D" & rowN).Formula = "=SUM(D" & startR & ":D" & endR & ")"
                check = False
            End If
            rowN = rowN + 1
        Else
            blankRows = blankRows + 1
            If check = False Then
                check = True
            End If
        End If
    Loop

    check = True
    blankRows = 0
    startR = 0
    endR = 0
    rowN = 2

    ThisWorkbook.Worksheets("ordersbySHIPdate").Activate
        Do Until blankRows = 15
        If Range("J" & rowN).Value <> "" Then
            blankRows = 0
            If check = True Then
                startR = rowN
                endR = Range("D" & rowN).End(xlDown).Row
                endR = endR - 1
                Range("D" & rowN).Formula = "=SUM(D" & startR & ":D" & endR & ")"
                check = False
            End If
            rowN = rowN + 1
        Else
            blankRows = blankRows + 1
            If check = False Then
                check = True
            End If
        End If
    Loop

    ThisWorkbook.Worksheets("by month").Activate
    MsgBox ("DONE!")

End Sub

Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

Function firstBlankRow(ws As Worksheet) As Long
    Dim rw As Range
    For Each rw In ws.UsedRange.Rows
        If rw.Address = ws.Range(rw.Address).SpecialCells(xlCellTypeBlanks). _
            Address Then
                firstBlankRow = rw.Row
                Exit For
        End If
    Next
    If firstBlankRow = 0 Then
        firstBlankRow = ws.Cells.SpecialCells(xlCellTypeLastCell). _
                    Offset(1, 0).Row
    End If
End Function

Please disregard the random variables that aren't used (not all the macro is pasted here, just the parts I'm having trouble with)

Any help would be greatly appreciated (and of course, if my attempt at this can be improved upon, I am very welcoming to any tips :) )

Thanks in advance!

Upvotes: 0

Views: 1076

Answers (2)

Bernard Saucier
Bernard Saucier

Reputation: 2260

As promised, I took a few minutes to go through your code and improved a few things. 

Sub Button1_Click()

    Dim colL As String, company As String, orderNumb As String
    Dim orderStatus As String, shipMethod As String, orderStock As String
    Dim countR As Long, countLoop As Long, LL As Long
    Dim startR As Long, endR As Long
    Dim oDate As Date, sDate As Date
    Dim total As Double
    Dim wb As Workbook, wsMonth As Worksheet
    Dim i As Integer, x As Integer, lastRow As Integer, rowN As Integer
    Dim check As Boolean
    Dim blankRows As Integer

    Set wb = ThisWorkbook
    Set wsMonth = wb.Worksheets("by month")
    Set wsLog = wb.Worksheets("ordersbyLOGdate")
    Set wsShip = wb.Worksheets("ordersbySHIPdate")
    countR = wsMonth.Cells(wsMonth.Rows.Count, 1).End(xlUp).Row
    countLoop = 1

    For i = 2 To countR

        company = wsMonth.Range("A" & i)
        orderNumb = Val(wsMonth.Range("B" & i))
        oDate = wsMonth.Range("C" & i)
        total = Val(wsMonth.Range("D" & i))
        orderStatus = wsMonth.Range("E" & i)
        shipMethod = wsMonth.Range("I" & Count)
        sDate = wsMonth.Range("J" & i)
        orderStock = wsMonth.Range("K" & i)

        LL = wsMonth.Range("D" & wsMonth.Rows.Count).End(xlUp).Row + 2

        rowN = 2
        lastRow = wsLog.Cells(wsLog.Rows.Count, 3).End(xlUp).Row
        Do Until wsLog.Range("C" & rowN) >= oDate
            If rowN > lastRow Then
                MsgBox "ERROR"
                Exit Sub
            End If
            rowN = rowN + 1
        Loop

        If wsLog.Range("C" & rowN) >= oDate Then

            If wsLog.Range("C" & rowN) > oDate Then
                Debug.Print "compare date is GREATER than oDate, - 1 from rowN and insert data there"
            End If

            wsLog.Rows(rowN).Insert
            wsLog.Range("A" & rowN) = company
            wsLog.Range("B" & rowN) = orderNumb
            wsLog.Range("C" & rowN) = oDate
            wsLog.Range("D" & rowN) = total
            wsLog.Range("E" & rowN) = orderStatus
            wsLog.Range("I" & rowN) = shipMethod
            wsLog.Range("J" & rowN) = sDate
            wsLog.Range("K" & rowN) = orderStock

        End If

        rowN = 2
        lastRow = wsShip.Cells(wsShip.Rows.Count, 3).End(xlUp).Row
        Do Until wsShip.Range("C" & rowN) >= sDate
            If rowN > lastRow Then
                MsgBox "ERROR"
                Exit Sub
            End If
            rowN = rowN + 1
        Loop

        If wsShip.Range("C" & rowN) >= sDate Then

            wsShip.Rows(rowN).Insert
            wsShip.Range("A" & rowN) = company
            wsShip.Range("B" & rowN) = orderNumb
            wsShip.Range("C" & rowN) = oDate
            wsShip.Range("D" & rowN) = total
            wsShip.Range("E" & rowN) = orderStatus
            wsShip.Range("I" & rowN) = shipMethod
            wsShip.Range("J" & rowN) = sDate
            wsShip.Range("K" & rowN) = orderStock

        End If

    Next

    MysteryFunk (wsLog)
    MysteryFunk (wsShip)

    wsMonth.Activate
    MsgBox ("DONE!")

End Sub

Function MysteryFunk(sheetName As Workheet)
    Dim rowN As Long, blankRows As Long, startR As Long, endR As Long
    Dim check As Boolean

    rowN = 2
    check = True
    blankRows = 0
    startR = 0
    endR = 0

    Do Until blankRows = 15
        If ws.Range("J" & rowN) <> "" Then
            blankRows = 0
            If check = True Then
                startR = rowN
                endR = ws.Range("D" & rowN).End(xlDown).Row
                endR = endR - 1
                ws.Range("D" & rowN).Formula = "=SUM(D" & startR & ":D" & endR & ")"
                check = False
            End If
            rowN = rowN + 1
        Else
            blankRows = blankRows + 1
            If check = False Then
                check = True
            End If
        End If
    Loop

End Function

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

  1. I used some workbook/worksheet objects to make sure we're working with the right .Ranges.

  2. I removed the "firstBlankRow" function and went ahead and used some solid built-in VBA functionality.

  3. I removed all the .Values as it's used by default when attributing a range to a variable (without using something like Set rng = Range("...") )

  4. I modified some sections to allow the code to be less repetitive and still perform the same actions.

  5. I grouped all the Dims at the top.

I'm not sure exactly what the (now named) "MysteryFunk" does; seems to add a partial sum when it finds some "valid" blank line. Also not sure where you meant to sort the data, but as answered earlier, simply use the Excel .Sort function.

Upvotes: 0

Kevin Cruz
Kevin Cruz

Reputation: 21

I think it is better to add all the data to the last part then sort it after, using this code:

ActiveWorkbook.Worksheets("ordersbyLOGdate").Activate
ActiveWorkbook.Worksheets("ordersbyLOGdate").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ordersbyLOGdate").Sort.SortFields.Add Key:=Range("C1:C" & rowN) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("ordersbyLOGdate").Sort
    .SetRange Range("A1:K" & rowN)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Upvotes: 1

Related Questions