Help Needed want to impress the Boss

jolivanes · #1 05-16-2017, 10:09 AM

I have tried several times to attach a workbook but no luck at all.

I have renamed the first sheet (Spelling)
I have changed the header in Column D (Spelling)

Instead of transferring every time you put an "y" or "Y" somewhere in column E, put an y in Column E in all the rows that need transferring and after you've done them all, click on the "Transfer" button.

You might look into the numbering of the colored cells in Column A. Same numbers might give wrong answers (rows 26 and 27 as well as rows 28 and 29).
You could put an A or B at the end maybe.

Code:

Sub Transfer()
Dim i As Long, a As String
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Deliveries")
Set sh2 = Sheets("Stock")
Application.ScreenUpdating = False
    For i = 2 To sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
        If sh1.Cells(i, 5).Value = "y" Then
            a = sh1.Cells(i, 1).Value
                sh2.Cells(sh2.Columns(3).Find(a, , , 1).Row, 7).Value = sh1.Cells(i, 5).Offset(, -1).Value
            sh1.Cells(i, 5).Offset(, -1).ClearContents
        End If
    Next i
Application.ScreenUpdating = True
End Sub

Suggy · #2 05-17-2017, 01:28 PM

Quote:

Originally Posted by jolivanes

I have tried several times to attach a workbook but no luck at all.

I have renamed the first sheet (Spelling)
I have changed the header in Column D (Spelling)

Instead of transferring every time you put an "y" or "Y" somewhere in column E, put an y in Column E in all the rows that need transferring and after you've done them all, click on the "Transfer" button.

You might look into the numbering of the colored cells in Column A. Same numbers might give wrong answers (rows 26 and 27 as well as rows 28 and 29).
You could put an A or B at the end maybe.

Code:

Sub Transfer()
Dim i As Long, a As String
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Deliveries")
Set sh2 = Sheets("Stock")
Application.ScreenUpdating = False
    For i = 2 To sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
        If sh1.Cells(i, 5).Value = "y" Then
            a = sh1.Cells(i, 1).Value
                sh2.Cells(sh2.Columns(3).Find(a, , , 1).Row, 7).Value = sh1.Cells(i, 5).Offset(, -1).Value
            sh1.Cells(i, 5).Offset(, -1).ClearContents
        End If
    Next i
Application.ScreenUpdating = True
End Sub

Hi Typos corrected (Thanks) I have put the macro in the spread sheet and added an extra line
sh1.Cells(i, 5).ClearContents
To clear the y from sheet1 as well as the number but when I click the button it replaces the stock on sheet2 instead of adding it to the stock that's already there. I don't have a clue what to do to add the 2 figures together so I would be most grateful if you could take another look for me?

Cheers

Ian

jolivanes · #3 05-17-2017, 08:10 PM

Quick and simple for now.
Change this line

Code:

sh2.Cells(sh2.Columns(3).Find(a, , , 1).Row, 7).Value = sh1.Cells(i, 5).Offset(, -1).Value

to this

Code:

sh2.Cells(sh2.Columns(3).Find(a, , , 1).Row, 7).Value = sh2.Cells(sh2.Columns(3).Find(a, , , 1).Row, 7).Value + sh1.Cells(i, 5).Offset(, -1).Value

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Outlook 2013 calendar reminders disabled on my calendar but show on boss's when i send invites	WUPJ	Outlook	0	08-06-2014 05:29 AM
TOC And my Boss	dynamictiger	Word	2	07-21-2014 09:51 PM
Please Help Before my boss drives me crazy!	amd250	Project	3	07-15-2014 09:10 AM
Want boss to email me at two addresses--can I set this up easily?	jessica19087	Outlook	1	08-26-2010 11:37 AM
I want to know how I can send emails on my boss' behalf	Jen	Outlook	2	07-29-2010 03:35 PM