Posts by rory

Private blnSkipEvents As Boolean
Public Sub ListBox1_Change()
blnSkipEvents = True
If ListBox1 = "Ost och mjölkprodukter" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [OstOMjölk].Value
ElseIf ListBox1 = "Fett och olja" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [FettOOlja].Value
ElseIf ListBox1 = "Bröd och spannmål" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [BrödOSpannmål].Value
ElseIf ListBox1 = "Potatis" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [Potatis].Value
ElseIf ListBox1 = "Grönsaker och baljväxter" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [GrönsakerOBaljväxter].Value
ElseIf ListBox1 = "Frukt och bär" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [FruktOBär].Value
ElseIf ListBox1 = "Kött, fisk, skaldjur, rom och ägg" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [KöttOFisk].Value
ElseIf ListBox1 = "Övrigt" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [Övrigt].Value
ElseIf ListBox1 = "Soppa, sås och matig sallad" Then
    ListBox2.Clear
    Sheets("Snabberäkning").ListBox2.List = [SoppaOsås].Value
End If


TextBox1 = vbNullString
TextBox2 = vbNullString
blnSkipEvents = False
End Sub


Private Sub ListBox2_Change()
   If blnSkipEvents Then Exit Sub
   UpDateTB2
End Sub


Private Sub TextBox1_Change()
   If blnSkipEvents Then Exit Sub
   UpDateTB2
End Sub
Private Sub UpDateTB2()
   Dim KCAL100 As Double
   Dim Livsmedel As String
   Dim rngFound As Range
   Dim wks As Worksheet
   If TextBox1 = vbNullString Then
       TextBox2 = vbNullString
       Exit Sub
   End If
   
   On Error Resume Next
   Livsmedel = ListBox2
   Set wks = ActiveWorkbook.Sheets("Databas, livsmedel")
   Set rngFound = wks.Range("A1:A2041").Find(What:=Livsmedel, LookAt:=xlWhole)
   
   If Not rngFound Is Nothing Then
      KCAL = rngFound.Offset(0, 3).Value / 100
      TextBox2 = Val(TextBox1) * KCAL
   End If
   
End Sub

Public Sub CommandButton1_Click()
Dim KCAL As Double
Dim Livsmedel As String
DIm rngFound as Range
Dim wks as Worksheet
Livsmedel = ListBox2
Set wks = ActiveWorkbook.Sheets("Databas, livsmedel")
wks.Activate
Set rngFound = wks.Range("A1:A2041").Find(What:=Livsmedel, LookAt:=xlWhole)
If rngFound is Nothing then
   msgbox Livsmedel & " not found"
Else
rngFound.Select
End if
End Sub

Public Sub ListBox1_Change()


If ListBox1 = "Övrigt" Then
    ListBox2.List = [Kategori].Value


End If


End Sub

Private lngCounter As Long


Private Sub Workbook_Open()
   lngCounter = Me.Windows.Count
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)
   If Me.Windows.Count < lngCounter Then
      Me.Close
      Exit Sub
   End If
   lngCounter = Me.Windows.Count
End Sub

Sub testing()
    ColourIt Selection, 15
End Sub
Sub ColourIt(rngIn As Range, intColour As Integer)
    Dim strTemp As String
    Dim varTemp
    Dim lngindex As Long, lngLen As Long
    Dim rngCell As Range
    For Each rngCell In rngIn
        lngLen = 0
        If Not rngCell.HasFormula Then
            strTemp = Replace(Replace(rngCell.Value, "<", "|"), ">", "|")
            If InStr(strTemp, "|") > 0 Then
                varTemp = Split(strTemp, "|")
'                rngCell.Value = Join(varTemp, "")
                For lngindex = LBound(varTemp) To UBound(varTemp)
                    If ((lngindex + 1) Mod 2 = 0) Then
                        rngCell.Characters(lngLen + 1, Len(varTemp(lngindex)) + 2).Font.ColorIndex = intColour
                        lngLen = lngLen + Len(varTemp(lngindex)) + 2
                     Else
                        rngCell.Characters(lngLen + 1, Len(varTemp(lngindex))).Font.ColorIndex = xlColorIndexAutomatic
                        lngLen = lngLen + Len(varTemp(lngindex))
                     End If
                Next lngindex
            End If
        End If
    Next rngCell
End Sub