Still unable to locate the case of a invalid sort

[ipbr21054]

Hi,
Ive touched on this before but never solved it so now having a clear head im trying once again.

I have a userform which once the fields are completed i press CommandButton1 which transfers the data to my worksheet & then sorts column A from
A-Z so far this is ok.

My problem is that column B C E are numbers.
So lets say cell B49 has the value 1991 in it.
In the cell at the top left corner is a small marker.

I also have filters so if i use the code at the bottom of this post "which is on a button" to sort the year from oldest "top of page" to newest "going down the page" the year 1991 is last.
All the years are correct down the worksheet apart from 1991 being last.

The same issue also resides for column C and E of which are also numbers

USERFORM TO WORKSHEET CODE

Private Sub CommandButton1_Click()    Dim i As Integer
    Dim ControlsArr As Variant, ctrl As Variant
    Dim x As Long
    For i = 1 To 6
       With Me.Controls("ComboBox" & i)
            If .ListIndex = -1 Then
                MsgBox "MUST SELECT ALL OPTIONS", 48, "SKP IMMO LIST TRANSFER"
                .SetFocus
                Exit Sub
            End If
        End With
    Next i
    
    ControlsArr = Array(Me.ComboBox1, Me.ComboBox2, Me.ComboBox3, Me.ComboBox4, Me.ComboBox5, Me.ComboBox6)
    
    With ThisWorkbook.Worksheets("SKPLIST")
        .Range("A4").EntireRow.Insert Shift:=xlDown
        .Range("A4:F4").Borders.Weight = xlThin
        .Range("A4:F4").Value = ControlsArr
    End With
    
    For Each ctrl In ControlsArr
        ctrl.Text = ""
    Next
    
    Application.ScreenUpdating = False
    With Sheets("SKPLIST")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A3:F" & x).Sort key1:=Range("A4"), order1:=xlAscending, Header:=xlGuess
    End With
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
    Sheets("SKPLIST").Range("A4").Select
    MsgBox "Database Has Been Updated", vbInformation, "SUCCESSFUL MESSAGE"
    Me.ComboBox1.SetFocus
End Sub

SORT FILTER

Private Sub ImmoYearButton_Click()    
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("SKPLIST")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        .Range("A3:F" & x).Sort key1:=Range("B4"), order1:=xlAscending, Header:=xlGuess
    
    End With
                      
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = True
    Sheets("SKPLIST").Range("A4").Select
    
End Sub

 

[MARK858]

In the cell at the top left corner is a small marker.

Is the marker green? if yes what does it say if you click on it and then the yellow diamond that appears? does it say number stored as text?

 

[ipbr21054]

Hi
It reads,
The number in this cell is formatted as text or preceeded by an apostrophe


If i type the same number in manuall all is ok so down to the code when its transfered ?
Thanks

 

[MARK858]

Select the column with the dates, click the data tab then text to columns and click finish.
Does the marker go? if yes what happens when you try the sort again?

 

[ipbr21054]

It shows cannot change part of a merged cell.

Nothing is merged.

can the code be altered so it saves as a number etc

 

[MARK858]

It shows cannot change part of a merged cell.Nothing is merged.

On a COPY of your sheet... Run the code below and see if any cells are colored red.

Sub Unmerge_CenterAcross()
    'Adapted from code by Erik Van Geit

    Dim lr As Long, lc As Long, i As Long, j As Long

    Dim cntUnmerged As Long, cntMerged As Long, mergeRng As Range
    Dim checkmerged As Boolean, LastMerged As String

    Dim AppSetCalc As Integer, StatusBarVisible As Boolean

    Dim msg As String, MaxRc As Long, ColorMe As Boolean



    With ActiveSheet

        lr = .UsedRange.Rows.Count
        lc = .UsedRange.Columns.Count
        With .Cells(lr, lc)
            If .MergeCells Then
                lr = lr + .MergeArea.Rows.Count - 1
                lc = lc + .MergeArea.Columns.Count - 1
            End If
        End With

        MaxRc = 5
        If MaxRc = 0 Then Exit Sub

        ColorMe = 1

        With Application
            .ScreenUpdating = False
            AppSetCalc = .Calculation
            .Calculation = xlCalculationManual
            StatusBarVisible = .DisplayStatusBar
            .DisplayStatusBar = True
            .EnableCancelKey = xlErrorHandler
        End With

        For i = 1 To lr
            On Error Resume Next
            checkmerged = .Range(.Cells(i, 1), .Cells(i, lc)).MergeCells

            If Err Or checkmerged Then
                Err.Clear
                For j = 1 To lc
                    With .Cells(i, j)
                        If .Resize(1, 1).MergeCells Then
                            cntMerged = cntMerged + 1
                            On Error GoTo stopit
                            With .MergeArea
                                If .Rows.Count <= MaxRc Then
                                    .HorizontalAlignment = xlCenterAcrossSelection
                                    If ColorMe Then .Interior.ColorIndex = 3
                                Else
                                    LastMerged = .Address(0, 0)
                                End If
                            End With
                        End If
                    End With
                Next j
            End If
        Next i

    End With

stopit:
    With Application
        .EnableCancelKey = xlDisabled
        .ScreenUpdating = True
        .Calculation = AppSetCalc
        .StatusBar = False
        .DisplayStatusBar = StatusBarVisible
    End With



    If Err Then msg = msg & Err.Description

End Sub

 

[ipbr21054]

Morning,

When i run the Macro i get an error of,
Compile error, Invalid qualifier.
This is the code below where the Err part of Err.Clear is blue

            If Err Or checkmerged Then
                Err.Clear

 

[MARK858]

I don't get that error, another question if you click the blue square between your column headers and your row numbers so that all your cells are selected and go to your home tab is merge and center highlighted?

 

[ipbr21054]

I assume the blue swquare is near enogh top left just below the print previw,print,save log then when i press it i see a message,

Run time error 6, Overflow

I click debug and see the following in yellow

If Target.Cells.Count > 1 Then

The code above is part of this whole code.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "F"


'   *** Specify start row ***
    myStartRow = 4
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
Target.Interior.Color = vbGreen
    Application.ScreenUpdating = True


End Sub

I delete that whole code and continue again.
This time i click the blue square & i see the merge & center shown a light orange colour

 

[MARK858]

This time i click the blue square & i see the merge & center shown a light orange colour

Then you definitely have merged cells.

Try running the code below for a list.

Sub FindMerged()
    Dim mycell As Range
    Dim myStr As String
    myStr = ""
    For Each mycell In ActiveSheet.UsedRange
        If mycell.MergeCells Then
            'mycell.Interior.ColorIndex = 3
            If myStr = "" Then
                myStr = "Merged worksheet cells:" & vbCr
            End If
            myStr = myStr & Replace(mycell.Address, "$", "") & vbCr
        End If
    Next
    If myStr = "" Then
        myStr = "No Merged Cells Found."
    End If
    MsgBox myStr
End Sub