Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 92
  • Last Modified:

vba - Macro to transfer from one sheet to another

Hi all

I have this below macro that transfer the full row from 1 sheet to another sheet. This is working great so for.

But now, when i double click in the cell from column AG, i need to transfer each rows that will link to the same Trip from column D

But since the trip number is not showing in all rows, i need to also look at the column J stops count.

Transfer-from-1-sheet-to-another.gif
So if i click in cell AG4 and there is a value in D4, it will transfer row 4 and 5 to the sheet called Consolidation since TRIP1 as 2 stops in column J

If i click in cell AG10 and there is a value in D10, it will transfer row 10 to 13 to the sheet called Consolidation since TRIP3 as 4 stops in column J

How can i do that?

Thanks again for your help.

Full code:
Dim WS2 As Worksheet
Dim ws As Worksheet
Dim MaxRow2 As Long

''''''''''''''''''''''''''''   Send info to Sharepoint   ''''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False

Set ws = ActiveSheet
Set WS2 = Sheets("Consolidation")

'MaxRow2 = WS2.Range("A" & WS.Rows.Count).End(xlUp).Row + 1
MaxRow2 = 2

'------Double-click cell B4 to enable the convert driver summary button again

If Intersect(Target, ws.Range("B4:B4")) Is Nothing Then

Else

	CommandButton1.Enabled = True

End If
'-----end of cell B4 enable

If Not Intersect(Target, ws.Range("AG:AG")) Is Nothing Then                                           'change to AG

	If Intersect(Target, ws.Range("AG:AG")) = "DIspatched " Then                                       'change to AG
		MsgBox "BOL was previously sent"
		Exit Sub
	Else

		If ws.Range("AF" & Target.Row) = "" Then                                                    'change to AF
			MsgBox "A carrier must be assigned to send BOL before dispatching"
			Exit Sub
		Else

			' Populates the Email1 tab with DC, BOL, Carrier, Line# and Filename

			ws.Range("A" & Target.Row).Copy WS2.Range("A" & MaxRow2)
			ws.Range("D" & Target.Row).Copy WS2.Range("B" & MaxRow2)
			ws.Range("AF" & Target.Row).Copy WS2.Range("C" & MaxRow2)                               'change to AF
			WS2.Range("D" & MaxRow2) = ActiveCell.Row

			WS2.Range("E" & MaxRow2) = ActiveWorkbook.Name

			' WS.Range("C" & Target.Row).Interior.ColorIndex = 4
			' MsgBox "Email Sent"

			'EMAIL FORMAT SETTING BEFORE SENDING IT

			MSG1 = MsgBox("Do you want to send the data to SharePoint?", vbYesNo, "Send...")

			If MSG1 = vbYes Then

				' Select the range of cells on the active worksheet.
				Sheets("Consolidation").Visible = True
				Sheets("Consolidation").Select

				Sheets("Consolidation").Range("A1:E4").Select
				With Selection.Validation
				.Delete
				.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
				:=xlBetween
				.IgnoreBlank = True
				.InCellDropdown = True
				.ShowInput = True
				.ShowError = True
			End With
			Sheets("Consolidation").Range("A2").Select

		End If
	End If
End If
End If

Open in new window

Transfer-data-test.xlsm
0
Wilder1626
Asked:
Wilder1626
  • 9
  • 8
  • 4
2 Solutions
 
gowflowCommented:
When you say


But now, when i double click in the cell from column AG, i need to transfer each rows that will link to the same Trip from column D

Do you mean simply copy paste in Consolidation these 2 or 3 rows ? or
look in consolidation to find Trip1 or Trip2 or  ... etc. and then get the data replaced like if you DoubleClick on AG and it is related to Trip4 that say is on row 25 in sheet Final

should we get this data at the end of existing data in Consolidation (meaning append it) or replace existing ? what if the Trip in consolidation does not exist what do we do we append it at the end ? do we leave blanks etc. ... Shall we respect also formatting ?

gowlfow
0
 
Wilder1626Author Commented:
Hi gowlfow

I would clear all actual Consolidation rows with data and replace with simply copy paste in Consolidation these 2 or 3 rows only.

So if they double click on TRIP1 example, It would clear the old data in Consolidation sheet and then, it would transfer 2 rows that links to TRIP1.

Just need to remember that the TRIPs may have different row counts every days. It's never the same.
0
 
FarWestCommented:
do you need to have a single row in consolidation sheet for all the trips or just another row that keeps trip name or id from previous row  if it blank in source?
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
gowflowCommented:
ok what do we do with the routine that is already in beforedoubleclick event ? we modify it ?
gowflow
0
 
Wilder1626Author Commented:
sure, we can modify the routine without any problem.
0
 
gowflowCommented:
Here it is this is the new beforedoubleclick sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim WS2 As Worksheet
Dim ws As Worksheet
Dim MaxRow2 As Long, MaxTrip As Long

''''''''''''''''''''''''''''   Send info to Sharepoint   ''''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False

Set ws = ActiveSheet
Set WS2 = Sheets("Consolidation")

MaxRow2 = 2

If Not Intersect(Target, ws.Range("AG:AG")) Is Nothing Then

    If Intersect(Target, ws.Range("AG:AG")) = "DIspatched " Then
        MsgBox "BOL was previously sent"
        Exit Sub
    Else

        If ws.Range("AF" & Target.Row) = "" Then
            MsgBox "A carrier must be assigned to send BOL before dispatching"
            Exit Sub
        Else

            ' Populates the Email1 tab with DC, BOL, Carrier, Line# and Filename
           WS2.Range("2:" & WS2.Rows.Count).EntireRow.Delete
           MaxTrip = ws.Range("J" & Target.Row).End(xlDown).Row
           ws.Range("A" & Target.Row & ":AQ" & MaxTrip).Copy WS2.Range("A" & MaxRow2)



            MSG1 = MsgBox("Do you want to send the data to SharePoint?", vbYesNo, "Send...")

            If MSG1 = vbYes Then
                Sheets("Consolidation").Visible = True
                Sheets("Consolidation").Select

                Sheets("Consolidation").Range("A1:E4").Select
                With Selection.Validation
                .Delete
                .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                :=xlBetween
                .IgnoreBlank = True
                .InCellDropdown = True
                .ShowInput = True
                .ShowError = True
            End With
            Sheets("Consolidation").Range("A2").Select

        End If
    End If
End If
End If
End Sub

Open in new window


pls see the attached file.
gowlfow
Transfer-data-test-V01.xlsm
0
 
FarWestCommented:
@jean I think there is some bugs in code
do you need only to have single trip in consolidation, since you did not increase Maxrow2 after copying rows
also is "DIspatched" imported from source or should be changed by vba code after copying or  "sending the data to SharePoint"
 is selected
0
 
Wilder1626Author Commented:
Hi FarWest

I only nee a single trip in the consolidation sheet. As for the Dispatched, this is VBA code after transferred into the consolidation sheet. I have the code that transfer that into sharepoint.


gowflow, i will test the file right now.
0
 
Wilder1626Author Commented:
gowflow, i've tested on a trip that only have 1 stop and it does not work properly. It also send the next trip first stops in Consolidation sheet also
0
 
FarWestCommented:
this is the modified VBA
please check
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim WS2 As Worksheet
Dim ws As Worksheet
Dim MaxRow2 As Long

''''''''''''''''''''''''''''   Send info to Sharepoint   ''''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False

Set ws = ActiveSheet
Set WS2 = Sheets("Consolidation")

MaxRow2 = 2

If Not Intersect(Target, ws.Range("AG:AG")) Is Nothing Then

    If Intersect(Target, ws.Range("AG:AG")) = "DIspatched " Then
        MsgBox "BOL was previously sent"
        Exit Sub
    Else

        If ws.Range("AF" & Target.Row) = "" Then
            MsgBox "A carrier must be assigned to send BOL before dispatching"
            Exit Sub
        Else

            ' Populates the Email1 tab with DC, BOL, Carrier, Line# and Filename
           'check if this is not the first stop
           Dim pStartRow As Integer, pEndRow
           pStartRow = Target.Row

           WS2.Range("2:" & WS2.UsedRange.Rows.Count).Clear
           If ws.Cells(pStartRow, 10).Value > 1 Then ' we have   move pack until we have one
           Do While True
           pStartRow = pStartRow - 1
           If ws.Cells(pStartRow, 10).Value = 1 Or pStartRow = 1 Then
           Exit Do
           End If
           Loop
           End If
              pEndRow = pStartRow
' find last stop row
        Do While True
           If ws.Cells(pEndRow + 1, 10).Value < 2 Then
           Exit Do
           End If
           pEndRow = pEndRow + 1
           Loop
    
           
           
           
           ws.Range("A" & pStartRow & ":AQ" & pEndRow).Copy WS2.Range("A" & MaxRow2)
            ws.Range("A" & pStartRow & ":I" & pStartRow).Copy WS2.Range("A" & MaxRow2 + 1 & ":I" & pEndRow - pStartRow + 2)


            MSG1 = MsgBox("Do you want to send the data to SharePoint?", vbYesNo, "Send...")

            If MSG1 = vbYes Then
                Sheets("Consolidation").Visible = True
                Sheets("Consolidation").Select

                Sheets("Consolidation").Range("A1:E4").Select
                With Selection.Validation
                .Delete
                .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
                :=xlBetween
                .IgnoreBlank = True
                .InCellDropdown = True
                .ShowInput = True
                .ShowError = True
            End With
            Sheets("Consolidation").Range("A2").Select

        End If
    End If
End If
End If
End Sub

Open in new window

0
 
Wilder1626Author Commented:
FarWest, Loks like it work great. Let me do one last test.
0
 
gowflowCommented:
I was answering No to sharepoint !!! you are answering yes ???

I tested the yes and fixed it. pls see this one
gowlfow
Transfer-data-test-V02.xlsm
0
 
Wilder1626Author Commented:
The issue i was getting was not about the sharePoint code portion but really to what transfer to the Consolidation sheet.
0
 
gowflowCommented:
I doubleclick in AG any cell (the first of a group) and it brings the whole group in consolidation is that what you want ?
gowflow
0
 
Wilder1626Author Commented:
i was saying in ID: 40616976 that  i've tested on a trip that only have 1 stop and it does not work properly. It was also sending the next trip first stops in Consolidation sheet at the same time.

That was a problem.
0
 
gowflowCommented:
Ahh I see all your examples didn't hv 1 trip !!! sorry for that

here it is.
Transfer-data-test-V03.xlsm
0
 
Wilder1626Author Commented:
Thanks gowflow, i will test this shortly and will let you now. I'm also testing FarWest's code.
0
 
gowflowCommented:
ok
0
 
Wilder1626Author Commented:
Thanks to both of you for your help.

Both work but i must say that i will use gowflow's on this project.


Thanks again
0
 
gowflowCommented:
glad I could help
gowflow
0
 
FarWestCommented:
Only 50 points. It less than how much coffee I drinked while fixing the code
LOL
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 9
  • 8
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now