Solved

vba - Macro to transfer from one sheet to another

Posted on 2015-02-18
21
68 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
User Form VBA Data + Print Sections 39 114
send keys not working in vba 7 46
Pivot help - Display only Is Not Null 7 17
Formula for time spans 10 23
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
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…

863 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

24 Experts available now in Live!

Get 1:1 Help Now