Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

vba - Macro to transfer from one sheet to another

Posted on 2015-02-18
21
Medium Priority
?
85 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 8
  • 4
21 Comments
 
LVL 31

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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 31

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 31

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 200 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
 
LVL 11

Author Comment

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

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 31

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 31

Accepted Solution

by:
gowflow earned 1800 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 31

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 31

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

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!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
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 demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

705 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