Solved

vba - Macro to transfer from one sheet to another

Posted on 2015-02-18
21
66 Views
Last Modified: 2016-02-10
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
Comment
Question by:Wilder1626
  • 9
  • 8
  • 4
21 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 40616896
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 40616924
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
 
LVL 12

Expert Comment

by:FarWest
ID: 40616927
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
 
LVL 29

Expert Comment

by:gowflow
ID: 40616932
ok what do we do with the routine that is already in beforedoubleclick event ? we modify it ?
gowflow
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40616937
sure, we can modify the routine without any problem.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40616952
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
 
LVL 12

Expert Comment

by:FarWest
ID: 40616955
@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
 
LVL 11

Author Comment

by:Wilder1626
ID: 40616965
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 40616976
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
 
LVL 12

Assisted Solution

by:FarWest
FarWest earned 50 total points
ID: 40617110
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 11

Author Comment

by:Wilder1626
ID: 40617151
FarWest, Loks like it work great. Let me do one last test.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40617163
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 40617173
The issue i was getting was not about the sharePoint code portion but really to what transfer to the Consolidation sheet.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40617177
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 40617179
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
 
LVL 29

Accepted Solution

by:
gowflow earned 450 total points
ID: 40617214
Ahh I see all your examples didn't hv 1 trip !!! sorry for that

here it is.
Transfer-data-test-V03.xlsm
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40617243
Thanks gowflow, i will test this shortly and will let you now. I'm also testing FarWest's code.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40617266
ok
0
 
LVL 11

Author Closing Comment

by:Wilder1626
ID: 40617543
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
 
LVL 29

Expert Comment

by:gowflow
ID: 40617549
glad I could help
gowflow
0
 
LVL 12

Expert Comment

by:FarWest
ID: 40617616
Only 50 points. It less than how much coffee I drinked while fixing the code
LOL
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

762 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

20 Experts available now in Live!

Get 1:1 Help Now