Macro to send data from "Input" sheet to "Data" sheet

mark2002 · Jan 19, 2023

Hi all,
Still quite new to macros and I am having difficulty creating one that sends data from one tab (titled "Input") to the "Data" tab.

Ideally, the macro would be able to take the data from the "Input" (first image), and send it to "Data" (second image) either replacing existing data (using Shape in column A as the reference) or adding the new shape and attributes.

Essentially, it would need to function as the example below. (the highlighted cells showing the new or updated data)

Currently, my macro is only able to take the top row from the "Input" sheet and send it to the "Data" sheet.
It is unable to send multiple rows, or replace any of the 'Shape' attributes.

Sub Input_Button()

Dim sourceSheet As Worksheet
Dim dataSheet As Worksheet
Dim nextRow As Long

Set sourceSheet = Sheets("Input")
Set dataSheet = Sheets("Data")

nextRow = dataSheet.Range("A" & dataSheet.Rows.Count).End(xlUp).Offset(1).Row

dataSheet.Cells(nextRow, 1).Value = sourceSheet.Range("B2").Value
dataSheet.Cells(nextRow, 2).Value = sourceSheet.Range("C2").Value
dataSheet.Cells(nextRow, 3).Value = sourceSheet.Range("D2").Value

sourceSheet.Range("B2:B200").Value = ""
sourceSheet.Range("C2:C200").Value = ""
sourceSheet.Range("D2:D200").Value = ""

End Sub

Please let me know if you can help.

Thanks you so much!
-Mark

HaHoBe · Jan 20, 2023

Hi Mark,

what about

VBA Code:

Sub Input_Button()
' https://www.mrexcel.com/board/threads/macro-to-send-data-from-input-sheet-to-data-sheet.1227471/
Dim lngNextRow As Long
Dim lngCounter As Long
Dim rngNext As Range
Dim wsSrc As Worksheet
Dim wsData As Worksheet
Dim WSF As WorksheetFunction

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row
  If WSF.CountIf(wsData.Columns(1), wsSrc.Cells(lngCounter, 2).Value) = 0 Then
    Set rngNext = wsData.Range("A" & wsData.Rows.Count).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, "B").Value
      .Interior.ColorIndex = 6
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, "C").Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      .Offset(0, 2).Value = wsSrc.Cells(lngCounter, "D").Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
    End With
  Else
    Set rngNext = wsData.Columns(1).Find(wsSrc.Cells(lngCounter, 2).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, "C").Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, "D").Value) Then
        .Offset(0, 2).Value = .Offset(0, 2).Value + wsSrc.Cells(lngCounter, "D").Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
  .Range("B2", .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, "D")).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

Ciao,
Holger

mark2002 · Jan 24, 2023

HaHoBe said:

Hi Mark,

what about

VBA Code:

Sub Input_Button()
' https://www.mrexcel.com/board/threads/macro-to-send-data-from-input-sheet-to-data-sheet.1227471/
Dim lngNextRow As Long
Dim lngCounter As Long
Dim rngNext As Range
Dim wsSrc As Worksheet
Dim wsData As Worksheet
Dim WSF As WorksheetFunction

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row
  If WSF.CountIf(wsData.Columns(1), wsSrc.Cells(lngCounter, 2).Value) = 0 Then
    Set rngNext = wsData.Range("A" & wsData.Rows.Count).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, "B").Value
      .Interior.ColorIndex = 6
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, "C").Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      .Offset(0, 2).Value = wsSrc.Cells(lngCounter, "D").Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
    End With
  Else
    Set rngNext = wsData.Columns(1).Find(wsSrc.Cells(lngCounter, 2).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, "C").Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, "D").Value) Then
        .Offset(0, 2).Value = .Offset(0, 2).Value + wsSrc.Cells(lngCounter, "D").Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
  .Range("B2", .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, "D")).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

Ciao,
Holger

Thank you so much, this works great! It will also save me an incredible amount of time for my data entry. Two questions.
First, on the line of code that deletes the input data.

.Range("B2", .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, "D")).Value = vbNullString

If I were to add additional columns before the reference column (Shape), how could I modify it so it also also deletes out those new columns?

i.e D is now the column with "Shape".
.Range("D2", .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, "G")).Value = vbNullString

Second, when I add number values, it currently sums them on the data sheet.
Is it possible to have the number in the input instead replace the value on the data sheet?

Thanks again!

HaHoBe · Jan 24, 2023

Hi mark2002,

you added Size as column as well...

I would slightly alter what you suggested to read

VBA Code:

  .Range("D2", .Cells(.Cells(.Rows.Count, "D").End(xlUp).Row, "G")).Value = vbNullString

as that would look for the last filled row in column D which is the area we work on (Shape is the only column thoroughly filled in the example).

Change

VBA Code:

       .Offset(0, 2).Value = .Offset(0, 2).Value + wsSrc.Cells(lngCounter, "D").Value

to

VBA Code:

       .Offset(0, 2).Value = wsSrc.Cells(lngCounter, "D").Value

to overwrite values instead of summing.

Holger

mark2002 · Jan 24, 2023

HaHoBe said:
Hi mark2002,

you added Size as column as well...

I would slightly alter what you suggested to read

VBA Code:

.Range("D2", .Cells(.Cells(.Rows.Count, "D").End(xlUp).Row, "G")).Value = vbNullString

as that would look for the last filled row in column D which is the area we work on (Shape is the only column thoroughly filled in the example).

Change

VBA Code:

.Offset(0, 2).Value = .Offset(0, 2).Value + wsSrc.Cells(lngCounter, "D").Value

to

VBA Code:

.Offset(0, 2).Value = wsSrc.Cells(lngCounter, "D").Value

to overwrite values instead of summing.

Holger

Hi Holger,

Thank you, that fixed the issue of values being summed.

Unfortunately it looks like I broke the code when I added the columns 'Main Category' & 'Sub Category' and I am unsure how to fix it. (details below)

You are correct in that only the 'Shape" column will be completely filled and always have data in it for the input and should be used as the reference.

(here is an example of how the final sheet will look) (First image is the input tab, and the second image is the data tab)

When I press submit, it replaces the cells with empty cells, instead of keeping any existing value.
In the example below, the shape 'Circle' already had data for 'Main' and 'Sub Category'. However, after pushing input it replaces those with empty calues.

Finally, after input only the first row and columns D-G are removed on the input sheet. (it will also sometimes even delete the titles in cells D1 through G1 after pressing 'Input')

Finally, does this site have a subscription or is it possible to tip/gift those who have helped? You all have been incredibly helpful!
-Mark
(My current code below)

VBA Code:

Sub Input_Button()

Dim lngNextRow As Long
Dim lngCounter As Long
Dim rngNext As Range
Dim wsSrc As Worksheet
Dim wsData As Worksheet
Dim WSF As WorksheetFunction

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, "D").End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, "D").End(xlUp).Row
  If WSF.CountIf(wsData.Columns(3), wsSrc.Cells(lngCounter, 4).Value) = 0 Then
    Set rngNext = wsData.Range("C" & wsData.Rows.Count).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, "D").Value
      '.Interior.ColorIndex = 6
          .Offset(0, -2).Value = wsSrc.Cells(lngCounter, "B").Value
      If Not IsEmpty(.Offset(0, -2).Value) Then .Offset(0, -2).Interior.ColorIndex = 6
          .Offset(0, -1).Value = wsSrc.Cells(lngCounter, "C").Value
      If Not IsEmpty(.Offset(0, -1).Value) Then .Offset(0, -1).Interior.ColorIndex = 6
        .Offset(0, 1).Value = wsSrc.Cells(lngCounter, "E").Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
        .Offset(0, 2).Value = wsSrc.Cells(lngCounter, "F").Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
        .Offset(0, 3).Value = wsSrc.Cells(lngCounter, "G").Value
      If Not IsEmpty(.Offset(0, 3).Value) Then .Offset(0, 3).Interior.ColorIndex = 6
      
    End With
  Else
    Set rngNext = wsData.Columns(1).Find(wsSrc.Cells(lngCounter, 2).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, "C").Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, "D").Value) Then
         .Offset(0, 2).Value = wsSrc.Cells(lngCounter, "D").Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
    .Range("D2", .Cells(.Cells(.Rows.Count, "D").End(xlUp).Row, "G")).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

HaHoBe · Jan 25, 2023

Hi Mark,

this is what I came up with. It may look complicated to you but using constants for the columns and rewriting some of the commands should make it easier to maintain. Code is untested so report back what doesn't fit - I will take my time and check before any further answer:

VBA Code:

Sub Input_Button()

Dim lngNextRow        As Long
Dim lngCounter        As Long
Dim rngNext           As Range
Dim wsSrc             As Worksheet
Dim wsData            As Worksheet
Dim WSF               As WorksheetFunction

Const cstrColMAIN     As String = "B"
Const cstrColSUB      As String = "C"
Const cstrColSHAPE    As String = "D"
Const cstrColCOLOR    As String = "E"
Const cstrColNUMBER   As String = "F"
Const cstrColSIZE     As String = "G"

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, "D").End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, cstrColSHAPE).End(xlUp).Row
  If WSF.CountIf(wsData.Cells(1, cstrColSHAPE).EntireColumn, wsSrc.Cells(lngCounter, cstrColSHAPE).Value) = 0 Then
    Set rngNext = wsData.Range(cstrColSHAPE & wsData.Rows.Count).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, cstrColSHAPE).Value
      '.Interior.ColorIndex = 6
      
      .Offset(0, -2).Value = wsSrc.Cells(lngCounter, cstrColMAIN).Value
      If Not IsEmpty(.Offset(0, -2).Value) Then .Offset(0, -2).Interior.ColorIndex = 6
      
      .Offset(0, -1).Value = wsSrc.Cells(lngCounter, cstrColSUB).Value
      If Not IsEmpty(.Offset(0, -1).Value) Then .Offset(0, -1).Interior.ColorIndex = 6
      
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, cstrColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
        
      .Offset(0, 2).Value = wsSrc.Cells(lngCounter, cstrColNUMBER).Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
        
      .Offset(0, 3).Value = wsSrc.Cells(lngCounter, cstrColSIZE).Value
      If Not IsEmpty(.Offset(0, 3).Value) Then .Offset(0, 3).Interior.ColorIndex = 6
    End With
  Else
    Set rngNext = wsData.Cells(1, cstrColSHAPE).EntireColumn.Find(wsSrc.Cells(lngCounter, cstrColSHAPE).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, cstrColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, cstrColNUMBER).Value) Then
        .Offset(0, 2).Value = wsSrc.Cells(lngCounter, cstrColNUMBER).Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
  .Range(.Cells(2, cstrColSHAPE), .Cells(.Cells(.Rows.Count, cstrColSHAPE).End(xlUp).Row, cstrColSIZE)).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

At the right bottom of a post from any other person you will find a Like-Button where you can express that you find a post useful. And if the problem is solved you as threadstarter can mark the thread according to Mark as Solution.

Ciao,
Holger

mark2002 · Jan 25, 2023

HaHoBe said:

Hi Mark,

this is what I came up with. It may look complicated to you but using constants for the columns and rewriting some of the commands should make it easier to maintain. Code is untested so report back what doesn't fit - I will take my time and check before any further answer:

VBA Code:

Sub Input_Button()

Dim lngNextRow        As Long
Dim lngCounter        As Long
Dim rngNext           As Range
Dim wsSrc             As Worksheet
Dim wsData            As Worksheet
Dim WSF               As WorksheetFunction

Const cstrColMAIN     As String = "B"
Const cstrColSUB      As String = "C"
Const cstrColSHAPE    As String = "D"
Const cstrColCOLOR    As String = "E"
Const cstrColNUMBER   As String = "F"
Const cstrColSIZE     As String = "G"

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, "D").End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, cstrColSHAPE).End(xlUp).Row
  If WSF.CountIf(wsData.Cells(1, cstrColSHAPE).EntireColumn, wsSrc.Cells(lngCounter, cstrColSHAPE).Value) = 0 Then
    Set rngNext = wsData.Range(cstrColSHAPE & wsData.Rows.Count).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, cstrColSHAPE).Value
      '.Interior.ColorIndex = 6
    
      .Offset(0, -2).Value = wsSrc.Cells(lngCounter, cstrColMAIN).Value
      If Not IsEmpty(.Offset(0, -2).Value) Then .Offset(0, -2).Interior.ColorIndex = 6
    
      .Offset(0, -1).Value = wsSrc.Cells(lngCounter, cstrColSUB).Value
      If Not IsEmpty(.Offset(0, -1).Value) Then .Offset(0, -1).Interior.ColorIndex = 6
    
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, cstrColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      
      .Offset(0, 2).Value = wsSrc.Cells(lngCounter, cstrColNUMBER).Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
      
      .Offset(0, 3).Value = wsSrc.Cells(lngCounter, cstrColSIZE).Value
      If Not IsEmpty(.Offset(0, 3).Value) Then .Offset(0, 3).Interior.ColorIndex = 6
    End With
  Else
    Set rngNext = wsData.Cells(1, cstrColSHAPE).EntireColumn.Find(wsSrc.Cells(lngCounter, cstrColSHAPE).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, cstrColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
    
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, cstrColNUMBER).Value) Then
        .Offset(0, 2).Value = wsSrc.Cells(lngCounter, cstrColNUMBER).Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
  .Range(.Cells(2, cstrColSHAPE), .Cells(.Cells(.Rows.Count, cstrColSHAPE).End(xlUp).Row, cstrColSIZE)).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

At the right bottom of a post from any other person you will find a Like-Button where you can express that you find a post useful. And if the problem is solved you as threadstarter can mark the thread according to Mark as Solution.

Ciao,
Holger

Hi Holger,

Thank you for sending the updated code! It
View attachment 83721

View attachment 83720

mark2002 · Jan 25, 2023

HaHoBe said:

Hi Mark,

this is what I came up with. It may look complicated to you but using constants for the columns and rewriting some of the commands should make it easier to maintain. Code is untested so report back what doesn't fit - I will take my time and check before any further answer:

VBA Code:

Sub Input_Button()

Dim lngNextRow        As Long
Dim lngCounter        As Long
Dim rngNext           As Range
Dim wsSrc             As Worksheet
Dim wsData            As Worksheet
Dim WSF               As WorksheetFunction

Const cstrColMAIN     As String = "B"
Const cstrColSUB      As String = "C"
Const cstrColSHAPE    As String = "D"
Const cstrColCOLOR    As String = "E"
Const cstrColNUMBER   As String = "F"
Const cstrColSIZE     As String = "G"

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, "D").End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, cstrColSHAPE).End(xlUp).Row
  If WSF.CountIf(wsData.Cells(1, cstrColSHAPE).EntireColumn, wsSrc.Cells(lngCounter, cstrColSHAPE).Value) = 0 Then
    Set rngNext = wsData.Range(cstrColSHAPE & wsData.Rows.Count).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, cstrColSHAPE).Value
      '.Interior.ColorIndex = 6
    
      .Offset(0, -2).Value = wsSrc.Cells(lngCounter, cstrColMAIN).Value
      If Not IsEmpty(.Offset(0, -2).Value) Then .Offset(0, -2).Interior.ColorIndex = 6
    
      .Offset(0, -1).Value = wsSrc.Cells(lngCounter, cstrColSUB).Value
      If Not IsEmpty(.Offset(0, -1).Value) Then .Offset(0, -1).Interior.ColorIndex = 6
    
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, cstrColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
      
      .Offset(0, 2).Value = wsSrc.Cells(lngCounter, cstrColNUMBER).Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
      
      .Offset(0, 3).Value = wsSrc.Cells(lngCounter, cstrColSIZE).Value
      If Not IsEmpty(.Offset(0, 3).Value) Then .Offset(0, 3).Interior.ColorIndex = 6
    End With
  Else
    Set rngNext = wsData.Cells(1, cstrColSHAPE).EntireColumn.Find(wsSrc.Cells(lngCounter, cstrColSHAPE).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, cstrColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
    
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, cstrColNUMBER).Value) Then
        .Offset(0, 2).Value = wsSrc.Cells(lngCounter, cstrColNUMBER).Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
  .Range(.Cells(2, cstrColSHAPE), .Cells(.Cells(.Rows.Count, cstrColSHAPE).End(xlUp).Row, cstrColSIZE)).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

At the right bottom of a post from any other person you will find a Like-Button where you can express that you find a post useful. And if the problem is solved you as threadstarter can mark the thread according to Mark as Solution.

Ciao,
Holger

Hi Holger,

*Sorry my last reply errored out.*

Thank you for the updated code! Unfortunately it appears to be off by one column. I was going to try and update it, but I didn't want to ruin anything.

Additionally, it still has the issue of not clearing out columns B & C on the input sheet.

Finally, it sometimes will delete the header text if you push input without adding input data. (Not a big issue, but just something I noticed)

Let me know if you need any more details.

Thank you again for all of your help!
-Mark

HaHoBe · Jan 25, 2023

Hi Mark,

I was about to answer "It for me is a song by Genesis from the album "The Lamb Lies Down on Broadway" from 1974 (last studio album with Peter Gabriel on lead vocals)."

When writing the code I forgot about the ranges being on different columns for both sheets.

Sheets Data before updating:

MrE_1227471_1701411_macro to send data_230120.xlsm

A

B

C

D

E

F

1

Main Category

Sub Category

Shape

Color

Number

Size

2

Circle

Red

3

All Shapes

Triangle

Green

4

Square

3

5

All Shapes

Large Shapes

Rectangle

Blue

12

Large

Data

Sheets Input before updating:

MrE_1227471_1701411_macro to send data_230120.xlsm

B

C

D

E

F

G

1

Main Category

Sub Category

Shape

Color

Number

Size

2

Large Shapes

Circle

Red

3

Square

3

4

Triangle

Green

5

All Shapes

Star

Silver

4

Small

Input

Sheets Data after updating:

MrE_1227471_1701411_macro to send data_230120.xlsm

A

B

C

D

E

F

1

Main Category

Sub Category

Shape

Color

Number

Size

2

Circle

Red

3

All Shapes

Triangle

Green

4

Square

3

5

All Shapes

Large Shapes

Rectangle

Blue

12

Large

6

All Shapes

Star

Silver

4

Small

Data

Sheets Input after updating:

MrE_1227471_1701411_macro to send data_230120.xlsm

B

C

D

E

F

G

1

Main Category

Sub Category

Shape

Color

Number

Size

2

Input

Code used:

Rich (BB code):

Sub Input_Button()

Dim lngNextRow        As Long
Dim lngCounter        As Long
Dim rngNext           As Range
Dim wsSrc             As Worksheet
Dim wsData            As Worksheet
Dim WSF               As WorksheetFunction

Const clngColMAIN     As Long = 2  '"B" for Input, "A" for Data
Const clngColSUB      As Long = 3  '"C"
Const clngColSHAPE    As Long = 4  '"D" <-- this is the interesting part
Const clngColCOLOR    As Long = 5  '"E"
Const clngColNUMBER   As Long = 6  '"F"
Const clngColSIZE     As Long = 7  '"G"

Set wsSrc = Sheets("Input")
Set wsData = Sheets("Data")
Set WSF = WorksheetFunction

If wsSrc.Cells(wsSrc.Rows.Count, clngColSHAPE).End(xlUp).Row > 1 Then
  wsData.UsedRange.Offset(1).Interior.Color = xlNone
End If

For lngCounter = 2 To wsSrc.Cells(wsSrc.Rows.Count, clngColSHAPE).End(xlUp).Row
  If WSF.CountIf(wsData.Cells(1, clngColSHAPE - 1).EntireColumn, wsSrc.Cells(lngCounter, clngColSHAPE).Value) = 0 Then
    Set rngNext = wsData.Cells(wsData.Rows.Count, clngColSHAPE - 1).End(xlUp).Offset(1)
    With rngNext
      .Value = wsSrc.Cells(lngCounter, clngColSHAPE).Value
      '.Interior.ColorIndex = 6
     
      .Offset(0, -2).Value = wsSrc.Cells(lngCounter, clngColMAIN).Value
      If Not IsEmpty(.Offset(0, -2).Value) Then .Offset(0, -2).Interior.ColorIndex = 6
     
      .Offset(0, -1).Value = wsSrc.Cells(lngCounter, clngColSUB).Value
      If Not IsEmpty(.Offset(0, -1).Value) Then .Offset(0, -1).Interior.ColorIndex = 6
     
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, clngColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
       
      .Offset(0, 2).Value = wsSrc.Cells(lngCounter, clngColNUMBER).Value
      If Not IsEmpty(.Offset(0, 2).Value) Then .Offset(0, 2).Interior.ColorIndex = 6
       
      .Offset(0, 3).Value = wsSrc.Cells(lngCounter, clngColSIZE).Value
      If Not IsEmpty(.Offset(0, 3).Value) Then .Offset(0, 3).Interior.ColorIndex = 6
    End With
  Else
    Set rngNext = wsData.Cells(1, clngColSHAPE - 1).EntireColumn.Find(wsSrc.Cells(lngCounter, clngColSHAPE).Value)
    With rngNext
      .Offset(0, 1).Value = wsSrc.Cells(lngCounter, clngColCOLOR).Value
      If Not IsEmpty(.Offset(0, 1).Value) Then .Offset(0, 1).Interior.ColorIndex = 6
     
      If Not IsEmpty(.Offset(0, 2).Value) Or Not IsEmpty(wsSrc.Cells(lngCounter, clngColNUMBER).Value) Then
        .Offset(0, 2).Value = wsSrc.Cells(lngCounter, clngColNUMBER).Value
        .Offset(0, 2).Interior.ColorIndex = 6
      End If
    End With
  End If
Next lngCounter

With wsSrc
  .Range(.Cells(2, 2), .Cells(.Cells(.Rows.Count, clngColSHAPE).End(xlUp).Row, clngColSIZE)).Value = vbNullString
End With

Set WSF = Nothing
Set wsData = Nothing
Set wsSrc = Nothing

End Sub

I ran the code a couple of times but could no spot any headers being deleted in Sheet Input. In any case we could set up the headers at the end of the procedure like

VBA Code:

With wsSrc
  .Range(.Cells(2, 2), .Cells(.Cells(.Rows.Count, clngColSHAPE).End(xlUp).Row, clngColSIZE)).Value = vbNullString
  .Cells(1, 2).Resize(1, 6).Value = Array("Main Category", "Sub Category", "Shape", "Color", "Number", "Size")
End With

HTH,
Holger

mark2002 · Jan 25, 2023

Hi Holger, thank you so much for all your help.
It appears to be working great for all instances except one... when I update an attribute in the column A or B it doesn't get updated on the Data sheet.

*Data sheet

*Input sheet

*Data sheet after input

Also, due to the challenges with having the "Shape" column in the middle, what if I moved the "Shape" column to the first position?
If this would be easier, I can update the sheet to look like below.

Let me know your thoughts.
Thank you again for everything!
-Mark

Macro to send data from "Input" sheet to "Data" sheet

mark2002

New Member

Excel Facts

HaHoBe

Well-known Member

mark2002

New Member

HaHoBe

Well-known Member

mark2002

New Member

HaHoBe

Well-known Member

mark2002

New Member

mark2002

New Member

HaHoBe

Well-known Member

mark2002

New Member

Similar threads

Forum statistics

Share this page

Macro to send data from "Input" sheet to "Data" sheet

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

New Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock