Transpose then sort

Babynod

Board Regular
Joined
Aug 10, 2022
Messages
56
Office Version
  1. 365
Platform
  1. Windows
Hi All,
i currently use a code to tranpose data from Column B Data Entry (sheet1) to Database (sheet 2) using a cmdbutton
VBA Code:
Private Sub CmbSubmit_Click()

    Dim srcSht As Worksheet, destSht As Worksheet
    Dim srcRng As Range, destRng As Range
    
    Set srcSht = Worksheets("Data Entry")
    Set destSht = Worksheets("Database")
    With destSht
        Set destRng = .Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
    
    With srcSht
        Set srcRng = .Range("B1:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
    End With
    
    srcRng.Copy
    destRng.PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
    Application.CutCopyMode = False
    
    Range("B:B").ClearContents

End Sub

Once its on sheet 2 and has been pasted i want it to autosort based on a custom sort order (this works by itself just not with the VBA above) which refeshes when data is manualy entered into the columns on sheet 2
using
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    ActiveSheet.AutoFilter.ApplyFilter

End Sub

1662421147548.png



how can i get this custom sort to sort when the data is inserted from the cmdbutton on sheet 1?
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
AFAIK, copy/paste with a macro does not trigger a Worksheet_Change event.
Code:
Sub Maybe()
Dim sh1 As Worksheet, sh2 As Worksheet, nr As Long, lr As Long
Set sh1 = Worksheets("Data Entry")
Set sh2 = Worksheets("Database")
lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
nr = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    sh2.Cells(nr, 1).Resize(, lr).Value = Application.Transpose(sh1.Range("B1:B" & lr).Value)
If Len(sh2.Cells(nr, 1)) <> 0 Then    'Call your Filter macro here
End Sub
With this you don't need a Worksheet_Change event

 
Upvote 0
Solution
Sub Maybe()
Dim sh1 As Worksheet, sh2 As Worksheet, nr As Long, lr As Long
Set sh1 = Worksheets("Data Entry")
Set sh2 = Worksheets("Database")
lr = sh1.Cells(Rows.Count, 2).End(xlUp).Row
nr = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh2.Cells(nr, 1).Resize(, lr).Value = Application.Transpose(sh1.Range("B1:B" & lr).Value)
If Len(sh2.Cells(nr, 1)) <> 0 Then 'Call your Filter macro here
End Sub
Where would i put this one? in the module or worksheet?
 
Upvote 0
Thanks for letting us know and good luck.
 
Upvote 0

Forum statistics

Threads
1,214,942
Messages
6,122,367
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top